Отображение данных объединенной ячейки в цикле For

Question

Я пытаюсь отобразить содержимое объединенной ячейки в цикле For в Excel, используя VBA.

У меня есть лист с очень простыми данными

Вот мой код:

'finding last record in my initial list    
sheet_last_row = Sheets("mylist").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To sheet_last_row
    last_row = Sheets("results").Cells(Rows.Count, 1).End(xlUp).Row

    If Sheets("mylist").Cells(i, 1).Value = 2 Then
        'test if cell is merged
        If Sheets("mylist").Cells(i, 2).MergeCells Then
            RowCount = Sheets("mylist").Cells(i, 2).Value
        End If
        Sheets("mylist").Cells(i, 1).EntireRow.Copy Sheets("results").Cells(last_row + 1, 1)
    End If
Next i

Я получаю следующий результат с этим кодом:

I 'Я новичок в этом.Может кто-нибудь показать мне, как сделать эту работу.

Answer 1

Вы можете попробовать:

Option Explicit

Sub test()

    Dim LastRowA As Long, LastRowB, LastRowC As Long, LastRowE As Long, MaxRow As Long
    Dim cell As Range, rng As Range

    With ThisWorkbook.Worksheets("Sheet1")

        'Find the lastrow for all the available columns
        LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastRowB = .Cells(.Rows.Count, "B").End(xlUp).Row
        LastRowC = .Cells(.Rows.Count, "C").End(xlUp).Row

        'Get the longer last row in order to avoid losing data if the last cell of a column is merge or empty
        MaxRow = WorksheetFunction.Max(LastRowA, LastRowB, LastRowC)

        'Set the area to loop
        Set rng = .Range("A2:C" & MaxRow)

        'Start looping
        For Each cell In rng

            'If the cell is merger
            If cell.MergeCells Then

                'Find the last row of column E
                LastRowE = .Cells(.Rows.Count, "E").End(xlUp).Row

                'Paste cell value in column E
                .Range("E" & LastRowE + 1).Value = cell.Value
                'Paste cell address in column F
                .Range("F" & LastRowE + 1).Value = cell.Address

            End If

        Next

    End With

End Sub

Результаты: