如何遍歷范圍直到單元格為空在Excel VBA中

Question

我一直試圖為我一直在努力工作的Excel和VBA拼湊出解決方案。 完全披露：我不是真正的開發人員，並且確實為之掙扎-即使它非常簡單（！），下面是我的問題的一個示例：

示例表

在上表中，我將占用另一本工作簿中A到C列的值粘貼到該工作簿的底部。 我在D和E列中也有公式，該公式處理A到C列中的信息。

通常，我將復制D和E列的第2行中的公式，並將其粘貼到D列下以處理粘貼到A到C中的新值。然后，我刷新了工作簿，因為我有數據透視表匯總了D和E列中的數據最后，我將所做的更改保存到工作簿中。

我一直在嘗試使該過程自動化，並湊合在一起完成上述操作，但是當我運行項目時，會產生“運行時錯誤：1004：應用程序定義的錯誤或對象定義的錯誤”。

下面的任何幫助將是巨大的幫助，我們將不勝感激。

謝謝

Sub Button1_Click()

'Step 1: Copy Range
Range("D2:E2").Copy

'Step 2: Move to row after last with formula in column D
Range("D" & Cells.Rows.Count).End(xlUp).Select
ActiveCell.Offset(1).Select
ActiveSheet.Cells(ActiveCell.Row, 1).Select

'Step 2: Paste formula
Call Paste_formula

'Step 3: Refresh Pivot table
ActiveWorkbook.RefreshAll

'Step 4: Save Workbook
ActiveWorkbook.Save

End Sub


Sub Paste_formula()

'Declare variables and set their types
Dim r As Range
Dim CurrRow As Long
Dim LastRow As Long

'Execute a series of statements in the 'Data' Worksheet
With Sheets("Data")
    'Set variable's values
    CurrRow = ActiveCell.Row
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    'For Loop which establishes the range for r being between the last row with Data in column D and the last row with Data in column A
    For Each r In .Range(CurrRow, LastRow)
        'In every row there is a remuneration data in column A
        If r.Value <> "" Then
        ' ...select the respective cell in column D...
            r.Offset(0, 4).Select
            ' ...and paste the current selection
            ActiveSheet.Paste
        End If
    Next r
End With

End Sub

Answer 1

我想知道是否有類似以下內容的內容，但是您是否正在更換工作表並仍希望與先前的ActiveCell一起使用？

Sub Paste_formula()

    Dim r As Range
    Dim CurrRow As Long
    Dim LastRow As Long

    With Sheets("Data")

        CurrRow = ActiveCell.Row
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For Each r In .Range("A" & CurrRow & ":A" & LastRow)

            If r.Value <> vbNullString Then r.Offset(0, 4) = r

        Next r

    End With

End Sub

Answer 2

更改：

For Each r In .Range(CurrRow, LastRow)

至：

For Each r In .Range(.Cells(LastRow, "A").Cells(CurrRow, "D"))

根據您在代碼注釋和當前代碼中寫的內容。