Макрос заканчивается рано - не работает до последней ячейки в столбце

Question

В настоящее время у меня есть следующий набор кодов, который должен помочь мне запустить Macro1 для каждой ячейки в столбце D, поэтому каждая ячейка не является пустой / пустой. Однако, с кодами ниже, он не вызывает Macro1 в последней не пустой / пустой ячейке столбца. Есть идеи, почему это так?

Обновление: я обнаружил, что l oop рано закончился на Next R. Это не продолжалось. Есть идеи, почему так?

Sub testing()

    Dim Rl As Long                      ' last row
    Dim Tmp As Variant
    Dim CellValue As Range
    Dim R As Long                       ' row counter

    With ThisWorkbook.ActiveSheet

        'To find out how many rows in D, counting from the last cell (Not blank)
        Rl = .Cells(.Rows.Count, "D").End(xlUp).Row

        ' work on column D
        For R = 1 To Rl  ' start the loop in row 1
            Tmp = .Cells(R, "D").Value
            If Len(Tmp) Then
                Cells(R, "D").Select
                Call Macro1
            End If
            Rl = .Cells(.Rows.Count, "D").End(xlUp).Row
        Next R
    End With
End Sub

Макрос1:

    Dim str As String
    Dim ArrStr() As String
    Dim i As Long
    Dim y As Long
    Dim RowsAdded As Boolean

    RowsAdded = False
    'Fill variables: str is the value of the active cell, ArrStr splits this value at the comma
    str = ActiveCell.Value
    ArrStr = Split(str, ", ")

    'Loop through each ArrStr to populate each cell below the activecell

    For i = 0 To UBound(ArrStr)
        ActiveCell.Offset(i, 0).Value = ArrStr(i)
        If RowsAdded = False Then
            For y = 1 To UBound(ArrStr)
                ActiveCell.Offset(1, 0).EntireRow.Insert xlDown
            Next y
            RowsAdded = True
        End If
    Next i


End Sub

Answer 1

Попробуйте следующий код. Вы имели большую часть этого в своем первоначальном посте выше, но я думаю, что были немного зациклены на для l oop и количестве ячеек в столбце D, в то время как вам не хватало того, что вы уже установили критерии выхода ..

Sub testing()

    Dim myRow As Long: myRow = 1
    With ThisWorkbook.ActiveSheet

        'Exit when first non empty cell is encountered
        Do While Len(.Cells(myRow, "D").Value)
            Cells(myRow, "D").Select
            Call macro
            myRow = myRow + 1
        Loop

    End With
End Sub

Answer 2

Просто выкладываю на всякий случай, если кому-нибудь понравится, как я это сделал Но он основан на ответе @ freeflow:

Sub testing()

    Dim myRow As Long: myRow = 1
    With ThisWorkbook.ActiveSheet

        'Exit when first non empty cell is encountered
        Do While Len(.Cells(myRow, "D").Value) Or Len(.Cells(myRow, "D").Value) = 0
            lastRow = Range("D65000").End(xlUp).Row

            Cells(myRow, "D").Select
            Call Macro1
            myRow = myRow + 1

            If myRow = finalRow Then
                Cells(finalRow, "D").Select
                Call Macro1
                Exit Do
            End If

        Loop

    End With
End Sub