VBA回圈代碼，直到列中的單元格為空

嘗試執行代碼回圈，直到 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

uj5u.com熱心網友回復：

您的回圈正在永久檢查 lastrow 的單元格值，但您想在每次運行時檢查每個單元格。正如評論中提到的，你必須增加一些東西。那個東西叫做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

當您增加迭代器的值時取決于您，這取決于給定回圈的構造。如果條件在回圈的開頭（直到 ; 就像你的情況一樣），那么你通常可能希望在回圈的最后增加，以便在下一次運行時檢查條件。

希望對你有幫助！

uj5u.com熱心網友回復：

完成交易。

謝謝@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

標籤：

上一篇：不同的被加數問題-貪心演算法（Python）

下一篇：如果第一個出現的單元格等于今天，將范圍行放在變數（Long）中？