0

我找到了一个宏，它从工作簿中的另一个单元格中减去工作簿中一个单元格中的值，以在最后的第三个工作簿中输出结果。它就这样存在

Sub Sample()
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim lngDiff As Long

    On Error GoTo Err

    Application.ScreenUpdating = False

    Set wb1 = ActiveWorkbook

    Set wb2 = Workbooks.Open("C:\FirstDataFile.xlsx")
    Set wb3 = Workbooks.Open("C:\SecondDataFile.xlsx")

    lngDiff = wb2.Sheets("Sheet1").Range("A1").Value - _
              wb3.Sheets("Sheet1").Range("A1").Value

    wb1.Sheets("Sheet1").Range("A1").Value = lngDiff

    wb3.Close savechanges:=False
    wb2.Close savechanges:=False

    Application.ScreenUpdating = True
    Exit Sub
Err:
    MsgBox Err.Description
End Sub

无论如何要修改此代码，它可以一次对多行执行此操作。

例如。让它减去 wb2.Sheets("Sheet1").Range("A1").Value - _ wb3.Sheets("Sheet1").Range("A1").Value 并将结果输出到 wb1.Sheets(" Sheet1").Range("A1").Value 然后对 A2、A3 等执行相同的操作，直到大约 A:120000？我还希望能够在我从中提取信息的两本书的多张纸上完成这项工作。这将如何完成？

谢谢！

4

1 回答 1

3

我建议在工作表名称列表中使用循环，并将减法外包给子程序InAllValuesOfColumnA，该子程序循环遍历每张工作表的所有行，如下所示。我进一步建议使用有意义的变量名而不是编号变量（这是一种不好的做法，很容易混淆）。

Option Explicit

Public Sub ExampleSample()
    Dim wbResult As Workbook, wbData As Workbook, wbSubtract As Workbook
    Dim lngDiff As Long

    On Error GoTo Err

    Application.ScreenUpdating = False

    Set wbResult = ActiveWorkbook
    Set wbData = Workbooks.Open("C:\FirstDataFile.xlsx")
    Set wbSubtract = Workbooks.Open("C:\SecondDataFile.xlsx")

    Dim WorksheetList() As Variant
    WorksheetList = Array("Sheet1", "Sheet2") 'add the worksheet names here

    Dim WsName As Variant
    For Each WsName In WorksheetList
        InAllValuesOfColumnA OfWorksheet:=wbData.Worksheets(WsName), SubtractWorksheet:=wbSubtract.Worksheets(WsName), WriteToWorksheet:=wbResult.Worksheets(WsName)
    Next WsName

    wbData.Close SaveChanges:=False
    wbSubtract.Close SaveChanges:=False

    Application.ScreenUpdating = True
    Exit Sub
Err:
    MsgBox Err.Description
End Sub


Private Sub InAllValuesOfColumnA(ByVal OfWorksheet As Worksheet, ByVal SubtractWorksheet As Worksheet, ByVal WriteToWorksheet As Worksheet)
    Dim LastRow As Long
    LastRow = OfWorksheet.Cells(OfWorksheet.Rows.Count, "A").End(xlUp).Row

    Dim iRow As Long
    For iRow = 1 To LastRow 'run from first to last row and subtract
        WriteToWorksheet.Cells(iRow, "A").Value = CLng(OfWorksheet.Cells(iRow, "A").Value - SubtractWorksheet.Cells(iRow, "A").Value)
    Next iRow
End Sub

一种更快的方法是在计算之前/之后将数据读/写到数组中：

Private Sub InAllValuesOfColumnA(ByVal OfWorksheet As Worksheet, ByVal SubtractWorksheet As Worksheet, ByVal WriteToWorksheet As Worksheet)
    Dim LastRow As Long
    LastRow = OfWorksheet.Cells(OfWorksheet.Rows.Count, "A").End(xlUp).Row

    'read all into array
    Dim DataColumn() As Variant
    DataColumn = OfWorksheet.Range("A1:A" & LastRow).Value

    Dim SubtractColumn() As Variant
    SubtractColumn = SubtractWorksheet.Range("A1:A" & LastRow).Value

    Dim ResultColumn() As Variant
    ResultColumn = WriteToWorksheet.Range("A1:A" & LastRow).Value


    Dim iRow As Long
    For iRow = LBound(ResultColumn) To UBound(ResultColumn) 'run from first to last row and subtract
        ResultColumn(iRow) = CLng(DataColumn(iRow) - SubtractColumn(iRow))
    Next iRow

    WriteToWorksheet.Range("A1:A" & LastRow).Value = ResultColumn
End Sub
于 2020-01-10T14:18:03.957 回答