Question

尝试将帐户编号和事务实例从选定工作簿中的2列（“C”和“D”列，从第13行开始）复制到我的工作簿，但前提是列D中的值大于另外，列中的最后一行标记为“总计”，所以显然我不想包含该行。

到目前为止，这就是我所拥有的：

Private Sub CmdGetData_Click()

Dim wb As Workbook, wb2 As Workbook
Dim NewFile As Variant
Dim ws As Worksheet, ws2 As Worksheet


NewFile = Application.GetOpenFilename("Excel-files (*.xlsx*, *.xlsx*")

If NewFile <> False Then
Set wb = ThisWorkbook
Set wb2 = Workbooks.Open(NewFile)
End If

Set ws = Worksheets("Main")
Set ws2 = wb2.Worksheets("IVR Late Fee Clean Up")

        lastrow1 = ws.Cells(Rows.Count, 2).End(xlUp).Row

        For i = 13 To lastrow2
            lastrow2 = wb2.ws2.Cells(Rows.Count, 3).End(xlUp).Row
            If wb2.ws2.Range("C" & i).Value = "Grand Total" Then GoTo Skip
            If wb2.ws2.Range("D" & i).Value = "2" Then
                wb.ws.Range("B" & lastrow1 + 1).Value = wb2.ws2.Range("C" & i)
                wb.ws.Range("C" & lastrow1 + 1).Value = wb2.ws2.Range("D" & i)
            End If
        Next i
Skip:

End Sub

我得到的问题是“运行时错误'9'：下标超出范围”。

请帮忙！

Answer 1

<强> 1 If wb2.ws2.Range("C" & i).Value = "Grand Total" Then GoTo Skip

需要：

If ws2.Range("C" & i).Value = "Grand Total" Then GoTo Skip

2。此外，

wb.ws.Range("B" & lastrow1 + 1).Value = wb2.ws2.Range("C" & i)

需要：

ws.Range("B" & lastrow1 + 1).Value = ws2.Range("C" & i)

等...

3。最后，你有一个For循环：

For i = 13 To lastrow2

但是，到目前为止，您从未为lastrow2设置值，只是在您拥有的以下行：

lastrow2 = wb2.ws2.Cells(Rows.Count, 3).End(xlUp).Row

所以你需要向上移动2行代码。

修改后的代码

Option Explicit

Private Sub CmdGetData_Click()

Dim wb As Workbook, wb2 As Workbook
Dim NewFile As Variant
Dim ws As Worksheet, ws2 As Worksheet
Dim lastrow1 As Long, lastrow2 As Long, i As Long

NewFile = Application.GetOpenFilename("Excel-files (*.xlsx*, *.xlsx*")

If NewFile <> False Then
    Set wb = ThisWorkbook
    Set wb2 = Workbooks.Open(NewFile)

    '====== ALL this code below needs to be inside the If NewFile <> False Then part =====

    Set ws = wb.Worksheets("Main")
    Set ws2 = wb2.Worksheets("IVR Late Fee Clean Up")

    lastrow1 = ws.Cells(Rows.Count, 2).End(xlUp).Row
    lastrow2 = ws2.Cells(Rows.Count, 3).End(xlUp).Row

    For i = 13 To lastrow2
        If ws2.Range("C" & i).Value = "Grand Total" Then Exit For

        If ws2.Range("D" & i).Value = "2" Then
            ws.Range("B" & lastrow1 + 1).Value = ws2.Range("C" & i).Value
            ws.Range("C" & lastrow1 + 1).Value = ws2.Range("D" & i).Value
        End If
    Next i
End If

End Sub

Answer 2

谢谢大家的意见。下面的代码工作了！（谢谢@ShaiRado）

Private Sub CmdGetData_Click()

Dim wb As Workbook, wb2 As Workbook
Dim NewFile As Variant
Dim ws As Worksheet, ws2 As Worksheet


NewFile = Application.GetOpenFilename("Excel-files (*.xlsx*, *.xlsx*")

If NewFile <> False Then
Set wb = ThisWorkbook
Set wb2 = Workbooks.Open(NewFile)
End If

Set ws = wb.Sheets("Main")
Set ws2 = wb2.Sheets("IVR Late Fee Clean Up")

        lastrow1 = ws.Cells(Rows.Count, 2).End(xlUp).Row
        lastrow2 = ws2.Cells(Rows.Count, 3).End(xlUp).Row

        For i = 13 To lastrow2
            If ws2.Range("C" & i).Value = "Grand Total" Then GoTo Skip
            If ws2.Range("D" & i).Value = "2" Then
                ws.Range("B" & lastrow1 + 1).Value = ws2.Range("C" & i)
                ws.Range("C" & lastrow1 + 1).Value = ws2.Range("D" & i)
            End If
        Next i
Skip:

End Sub

和@Ryszard：我没有得到调试选项，因为我是从脚本编辑器运行的，而不是实际的命令按钮。我的错误。

VBA复制2列基于值1从一个工作簿到另一个工作簿

2 个答案: