Question

我正在尝试编写一个脚本，该脚本将比较两个都有80张纸的工作簿。工作表名称在两个工作簿中都将匹配（一个工作簿是产品副本，一个是UAT环境中的副本。所有数据应该相同）。我能够运行一个脚本来比较我指定的工作表，但是在尝试弄清楚如何比较每个工作表时遇到困难。

Sub CompareWorksheets()

Dim varSheetA As Worksheet
Dim varSheetB As Worksheet
Dim varSheetAr As Variant
Dim varSheetBr As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long
Dim wbkc As Workbook


Set wbkc = ThisWorkbook  'this is where results of comparison will be documented
Set wbka = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard1.xlsx")  'PROD
Set wbkb = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard2.xlsx") 'UAT

            Set varSheetA = wbka.Worksheets("Members")
            Set varSheetB = wbkb.Worksheets("Members")
            strRangeToCheck = ("A5:A10")

            varSheetAr = varSheetA.Range(strRangeToCheck).Value
            varSheetBr = varSheetB.Range(strRangeToCheck).Value

   erow = 6 'starting row to document summary results

    For iRow = LBound(varSheetAr, 1) To UBound(varSheetAr, 1)
    For iCol = LBound(varSheetAr, 2) To UBound(varSheetAr, 2)

            If varSheetAr(iRow, iCol) = varSheetBr(iRow, iCol) Then
              varSheetA.Cells(iRow, iCol).Interior.ColorIndex = xlNone
              varSheetB.Cells(iRow, iCol).Interior.ColorIndex = xlNone
            Else
              varSheetA.Cells(iRow, iCol).Interior.ColorIndex = 22
              varSheetB.Cells(iRow, iCol).Interior.ColorIndex = 22

                wbkc.Activate
                    erow = erow + 1
                        wbkc.Sheets("Summary").Cells(erow, 2) = iRow
                        wbkc.Sheets("Summary").Cells(erow, 3) = iCol
                        wbkc.Sheets("Summary").Cells(erow, 4) = varSheetA.Cells(iRow, iCol)
                        wbkc.Sheets("Summary").Cells(erow, 5) = varSheetB.Cells(iRow, iCol)

            End If
        Next
    Next
End Sub

Answer 1

您需要遍历其中一个工作簿的工作表，并使用工作表名称为第二个工作簿设置工作表变量。

Sub CompareWorksheets()

    Dim wbPROD As Workbook, wbUAT As Workbook, wbSummary As Workbook
    Dim wsPROD As Worksheet, wsUAT As Worksheet, wsSummary As Worksheet
    Dim arrPROD As Variant, arrUAT As Variant
    Dim strRangeToCheck As String
    Dim iRow As Long, iCol As Long

    Set wbSummary = ThisWorkbook                      'this is where results of comparison will be documented
    Set wsSummary = wbkc.Sheets("Summary")
    Set wbPROD = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard1.xlsx")    'PROD
    Set wbUAT = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard2.xlsx")    'UAT

    strRangeToCheck = ("A5:A10")

    erow = 6                                          'starting row to document summary results

    For Each wsPROD In wbPROD.Worksheets
        Set wsUAT = wbUAT.Worksheets(wsPROD.Name)
        arrPROD = wsPROD.Range(strRangeToCheck).Value
        arrUAT = wsUAT.Range(strRangeToCheck).Value

        For iRow = LBound(arrPROD, 1) To UBound(arrPROD, 1)
            For iCol = LBound(arrPROD, 2) To UBound(arrPROD, 2)

                If arrPROD(iRow, iCol) = arrUAT(iRow, iCol) Then
                    wsPROD.Cells(iRow, iCol).Interior.ColorIndex = xlNone
                    wsUAT.Cells(iRow, iCol).Interior.ColorIndex = xlNone
                Else
                    wsPROD.Cells(iRow, iCol).Interior.ColorIndex = 22
                    wsUAT.Cells(iRow, iCol).Interior.ColorIndex = 22

                    wbkc.Activate
                    erow = erow + 1
                    With wsSummary
                        .Cells(erow, 2) = iRow
                        .Cells(erow, 3) = iCol
                        .Cells(erow, 4) = wsPROD.Cells(iRow, iCol)
                        .Cells(erow, 5) = wsUAT.Cells(iRow, iCol)
                    End With
                End If
            Next
        Next
    Next

End Sub

Answer 2

Start with
  Option Explicit  ' to force you to declare for each variable

Add code to delete prior errors
  Dim wbkc As Workbook, LastRow as Long, nRow as Long
  wbkc.Sheets("Summary").UsedRange 'Refresh UsedRange
  LastRow = wbkc.Sheets("Summary").UsedRange.Rows(wbkc.Sheets("Summary").UsedRange.Rows.Count).Row
  For nRow = LastRow to eRow + 1 step -1
    wbkc.Sheets("Summary").Rows(nRow).Delete
  Next nRow

Basically, google "excel vba for each sheet" and look at the first one 
  https://stackoverflow.com/questions/21918166/excel-vba-for-each-worksheet-loop
to get the driving code (ignoring resizingColumns) and create CompareCells. 

  Sub forEachWs()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        Call CompareCells(ws)
    Next
  End Sub
  Sub CompareCells(ws as Worksheet)
  End Sub

Finally, Add your code inside of CompareCells
Giving  (PLEASE test this code, since we do not have wbka or wbkb excel files)


Option Explicit  ' to force you to declare for each variable

' define output -- this is where results of comparison will be documented
Dim wbkc As Workbook, eRow as long, LastRow as Long, nRow as Long
Set wbkc = ThisWorkbook  
eRow = 6 'starting row to document summary results
wbkc.Sheets("Summary").UsedRange 'Refresh UsedRange
LastRow = wbkc.Sheets("Summary").UsedRange.Rows(wbkc.Sheets("Summary").UsedRange.Rows.Count).Row
For nRow = LastRow to eRow + 1 step -1
    wbkc.Sheets("Summary").Rows(nRow).Delete  ' delete prior errors
Next nRow


' define inputs -- 
Dim wbka As Workbook, wbkb As Workbook
Set wbka = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard1.xlsx")  'PROD
Set wbkb = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard2.xlsx") 'UAT

' step thru each sheet
Dim ws As Worksheet
For Each ws In wbka.Worksheets
    '
    Dim varSheetA As Worksheet, varSheetB As Worksheet
    Dim varSheetAr As Variant, varSheetBr As Variant
    Dim strRangeToCheck As String

    Set varSheetA = wbka.Worksheets(ws.Name)
    Set varSheetB = wbkb.Worksheets(ws.Name)
    strRangeToCheck = ("A5:A10")

    varSheetAr = varSheetA.Range(strRangeToCheck).Value
    varSheetBr = varSheetB.Range(strRangeToCheck).Value

    ' step thru each cell
    Dim iRow As Long, iCol As Long
    For iRow = LBound(varSheetAr, 1) To UBound(varSheetAr, 1)
    For iCol = LBound(varSheetAr, 2) To UBound(varSheetAr, 2)

            If varSheetAr(iRow, iCol) = varSheetBr(iRow, iCol) Then
              varSheetA.Cells(iRow, iCol).Interior.ColorIndex = xlNone
              varSheetB.Cells(iRow, iCol).Interior.ColorIndex = xlNone
            Else
              varSheetA.Cells(iRow, iCol).Interior.ColorIndex = 22
              varSheetB.Cells(iRow, iCol).Interior.ColorIndex = 22

                wbkc.Activate
                    erow = erow + 1

                        wbkc.Sheets("Summary").Cells(erow, 1) = ws.Name  'ADDed
                        wbkc.Sheets("Summary").Cells(erow, 2) = iRow
                        wbkc.Sheets("Summary").Cells(erow, 3) = iCol
                        wbkc.Sheets("Summary").Cells(erow, 4) = varSheetA.Cells(iRow, iCol)
                        wbkc.Sheets("Summary").Cells(erow, 5) = varSheetB.Cells(iRow, iCol)

            End If
        Next iCol
    Next iRow


Next ws

比较两本各有80张的工作簿

2 个答案: