VBA循环代码，直到一列中的单元格为空

Question

尝试执行代码循环，直到 A 列中的最后一个单元格。

尝试使用 For 但不理解某些内容并尝试使用 Do Until。它有点工作，但在粘贴详细信息代码后卡住了。

我的代码如下有谁知道为什么会卡住？

Sub Pivot()
    Dim lastrow_blank As Long
    Dim lastrow_blankA As Long
    Dim lastrow_blankselection As Long
    Dim a As Long
    
    Sheets("Report").Select ' Select sheet '
    
    ThisWorkbook.RefreshAll ' Refresh Pivot '

    Data = Date - 1 ' Yesterdays date '
    
    lastrow_blank = Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row + 1 ' first blank cell in column B '
    lastrow_blankA = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1 ' first blank cell in column A '
    lastrow_blankselection = CDate(Cells(lastrow_blank, 1).Value) ' Value selection of the last low in column A '
    
    a = Range("A2").Value
    
    Range("A3:A" & CLng(Date - a + 1)).Value = Evaluate("Row(" & a + 1 & ":" & CLng(Date) & ")") ' Paste date's until yesterday in column A '

    Do Until IsEmpty(Cells(lastrow_blank, 1)) ' loop starts '
        If Cells(lastrow_blank, 1) = "" Then ' If first cell in column B is empty then '
            MsgBox "Info" ' Message if cell is empty '
            Exit Sub
        Else
            ActiveWorkbook.SlicerCaches("NativeTimeline_Value_Date").TimelineState. _
            SetFilterDateRange lastrow_blankselection, lastrow_blankselection           ' this code selects a timeline date '
            ActiveWorkbook.SlicerCaches("NativeTimeline_Good_Date").TimelineState. _
            SetFilterDateRange lastrow_blankselection, lastrow_blankselection           ' this code selects a timeline date '
            
            Sheets("Report").Range("O4:Z4").Copy ' Copy cells that returns details from Pivot '
    
            Cells(lastrow_blank, 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False ' Paste details from Pivot to celected cells'
            
            ' when the code is launched it loops first time correctly and then after the paste code it gets stuck i think because it does nothing'
            ' After I cancel the code paste code get highlited in yellow '
        End If
    Loop
End Sub

Answer 1

您的循环是永久检查 lastrow 的单元格值，但您希望在每次运行时检查每个单元格。正如 cmets 中提到的，您必须增加一些东西。这个东西叫做iterator，所以你必须：

1. 将某个变量声明为整数/长整数

2. 在每次循环运行时将其值加 1

3. 您还应该更正循环的条件：

Do Until IsEmpty(Cells(lastrow_blank, 1)) ' loop starts '

结果应该是这样的

[...]
dim Iterator as Integer
Iterator = 1

`Do Until IsEmpty(Cells(Iterator, 1)) ' loop starts '`
[...]
Iterator = Iterator + 1 'Incrementation
loop

增加迭代器的值取决于你，这取决于给定循环的构造。如果条件在循环的开头（执行 until ; 如您的情况），那么您通常可能希望在循环的最后递增，以便在下次运行时检查条件。

希望对你有所帮助！

Answer 2

完成交易。

感谢@kamikadze366

Sub Datos_nustatymas()

Dim lastrow_blank As Long
Dim lastrow_blankA As Long
Dim lastrow_blankselection As Long
Dim a As Long

Sheets("Report").Select ' Select sheet '

ThisWorkbook.RefreshAll ' Refresh Pivot '

Data = Date - 1 ' Yesterdays date '

lastrow_blankA = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1 ' first blank cell in column A '
lastrow_blank = Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row + 1 ' first blank cell in column B '

a = Range("A2").Value
Range("A3:A" & CLng(Date - a + 1)).Value = Evaluate("Row(" & a + 1 & ":" & CLng(Date) & ")") ' Paste date's until yesterday in column A '

Do Until IsEmpty(Cells(lastrow_blank, 1))

lastrow_blankselection = CDate(Cells(lastrow_blank, 1).Value) ' Value selection of the last low in column A '

If Cells(lastrow_blank, 1) = "" Then ' If first cell in column B is empty then '
MsgBox "Info" ' Message if cell is empty '
Exit Sub
    Else
ActiveWorkbook.SlicerCaches("NativeTimeline_Value_Date").TimelineState. _
        SetFilterDateRange lastrow_blankselection, lastrow_blankselection           ' this code selects a timeline date '
    ActiveWorkbook.SlicerCaches("NativeTimeline_Good_Date").TimelineState. _
        SetFilterDateRange lastrow_blankselection, lastrow_blankselection           ' this code selects a timeline date '
        
Sheets("Report").Range("O4:Z4").Copy ' Copy cells that returns details from Pivot '

Cells(lastrow_blank, 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False ' Paste details from Pivot to celected cells'
        
        ' when the code is launched it loops first time correctly and then after the paste code it gets stuck i think because it does nothing'
        ' After I cancel the code paste code get highlited in yellow '
          End If
        lastrow_blank = lastrow_blank + 1
       Loop
End Sub