Смещение данных верхнего левого угла от диапазона до первых двух столбцов с данными

Question

Я все еще довольно новичок в VBA, и у меня возникают проблемы с использованием функции диапазона смещения для циклического просмотра кода и перемещения данных в верхнем левом углу каждого диапазона в моем отчете в две колонки слева.

Например, мой оригинальный отчет выглядит следующим образом:

4101     Canada
GJ002568    



4102     Mexico
GJ002566    
GJ002566    



4103     Newcastle
GJ002567    
00001626    
00001634    

Мне нужно отформатировать его следующим образом:

 4101     Canada     GJ002568


 4102     Mexico     GJ002566
 4102     Mexico     GJ002566


 4103     Newcastle  GJ002567
 4103     Newcastle  00001626
 4103     Newcastle  00001634

Строки на листе должны быть динамическимипотому что я не всегда буду знать длину, и диапазоны также должны быть одинаковыми, потому что в каждом есть разные суммы.Я написал макрос, чтобы помочь в написании имени в последней строке, но он делает то, что мне нужно.

Sub WriteNames()
Dim LastRow As Long
    LastRow = Cells(Rows.Count, 3).End(xlUp).Row 'This three references the last row in column B

    Dim i As Long

    For i = 2 To LastRow   'This starts at 2 because the first row is a header
        If Cells(i, 1).Value = ""
        Cells(i, 1).Value = Cells(i - 1, 1).Value  'The neg one ref cell above
    Next i
End Sub

Буду признателен за любые предложения или помощь!

Answer 1

Попробуйте сохранить первичные ключи в массиве.

Sub writeNames()
    Dim i As Long, lr As Long, arr() As Variant
    With Worksheets("sheet")
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lr
            If CBool(Len(.Cells(i, "A").Value)) And CBool(Len(.Cells(i, "B").Value)) Then
                arr = .Cells(i, "A").Resize(1, 2).Value
                .Cells(i, "A").Resize(1, 2).ClearContents
            ElseIf CBool(Len(.Cells(i, "A").Value)) Then
                .Cells(i, "C").NumberFormat = "@"
                .Cells(i, "C") = .Cells(i, "A").Value
                .Cells(i, "A").Resize(1, 2) = arr
            End If
        Next i
        With .Cells(2, "A").Resize(lr, 3)
            .Sort Key1:=.Cells(1), Order1:=xlAscending, _
                  Orientation:=xlTopToBottom, Header:=xlNo
        End With
    End With
End Sub

Я использовал элементарную сортировку, чтобы удалить «мертвые» строки и отформатированный столбец C как текст, чтобы сохранить начальные нули для некоторых записей.

исходные данные