检查不同工作表中的列相同的工作簿vba

Question

我刚刚开始使用 vba 来寻找一种检查两个 excel 表的方法。我浏览了所有可以在这里找到的关于将 excel 中的表与 vba 进行比较的答案，最后找到了这个答案 VBA - Compare Tables on 2 Sheets with Differences R.Katnaan 给出了最好的结果。 所以我正在尝试根据我的情况进行调整和实施。 这些工作表是目标并使用结果的输出工作表进行计数。根据输出表中的参考，我选择的工作表会动态更改，用户通过下拉列表决定要检查的文件。 代码始终检查工作表目标和计数上从第 3 行开始的 b 列。

代码可以正常工作，但对于大型工作表（超过 100 行）需要很长时间。例如，对于具有 3500 行的工作表，需要 3 分 45 秒才能得出结果，并且上面有错误（结果丢失）。我猜是 do while 函数，但我不确定。有没有办法优化代码？提前感谢您的宝贵时间。

Public Sub Compare_sheets()

    Dim targetSheet, countingSheet, outputSheet As Worksheet
    Dim startrow, outputRow, temptargetRow, tempcountingRow, countingRowCount, targetRowCount, totalRowCount, finishedcountingIndex As Integer
    Dim finishedcounting() As String
    Dim isExist As Boolean
    
    
    'Do in background
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    'Set sheets
    Set targetSheet = Sheets(Sheets("Compare Sheets").Range("C3").Value)
    Set countingSheet = Sheets(Sheets("Compare Sheets").Range("C4").Value)
    Set outputSheet = Sheets("Compare Sheets")

    'Set start row of each sheet for data
    startrow = 3
    outputRow = 2

    'Get row count from counting sheet and targetsheet
    countingRowCount = countingSheet.Range("b" & startrow).End(xlDown).Row
    targetRowCount = targetSheet.Range("b" & startrow).End(xlDown).Row
    
    'Check which is bigger
    If countingRowCount < targetRowCount Then
        totalRowCount = targetRowCount
    Else
        totalRowCount = countingRowCount
    End If
    'Set index
    finishedcountingIndex = 0

    'Re-define array
    ReDim finishedcounting(0 To totalRowCount - 1)

    'Set the start row
    temptargetRow = startrow

    'Here I looped with OR state, you can modify it to AND start if you want
    Do

        'Reset exist flag
        isExist = False

        'loop all row in counting sheet
        For tempcountingRow = 1 To totalRowCount Step 1

            'If row is not finished for checking.
            If UBound(Filter(finishedcounting, tempcountingRow)) < 0 Then

                'If all cell are equal
                If targetSheet.Range("b" & temptargetRow) = countingSheet.Range("b" & tempcountingRow) Then

                    'Set true to exist flag
                    isExist = True

                    'Store finished row
                    finishedcounting(finishedcountingIndex) = tempcountingRow

                    finishedcountingIndex = finishedcountingIndex + 1

                    'exit looping
                    Exit For

                End If

            End If

        Next tempcountingRow

        'Show result
        outputSheet.Range("g" & outputRow) = targetSheet.Range("b" & temptargetRow)
        outputSheet.Range("h" & outputRow) = targetSheet.Range("c" & temptargetRow)
        outputSheet.Range("i" & outputRow) = targetSheet.Range("d" & temptargetRow)

        If isExist Then
            outputSheet.Range("f" & outputRow) = "FOUND"
        Else
            outputSheet.Range("f" & outputRow) = "MISSING"
        End If

        'increase output row
        outputRow = outputRow + 1

        'go next row
        temptargetRow = temptargetRow + 1

    Loop While targetSheet.Range("B" & temptargetRow) <> vbNullString ' Or targetSheet.Range("B" & temptargetRow) <> "" Or targetSheet.Range("C" & temptargetRow) <> ""

    'loop all row in counting sheet
    For tempcountingRow = 1 To totalRowCount Step 1

        'If row is not finished for checking.
        If UBound(Filter(finishedcounting, tempcountingRow)) < 0 Then

            'Show result
            outputSheet.Range("g" & outputRow) = countingSheet.Range("b" & tempcountingRow)
            outputSheet.Range("j" & outputRow) = countingSheet.Range("c" & tempcountingRow)
            'outputSheet.Range("C" & outputRow) = countingSheet.Range("C" & tempcountingRow)
            outputSheet.Range("f" & outputRow) = "ADDITIONAL"

            'increase output row
            outputRow = outputRow + 1

        End If

    Next tempcountingRow
    
    'Update
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub 

Answer 1

使用Dictionary Object。

Option Explicit
Public Sub Compare_sheets2()

    Const ROW_START = 3
    Const COL_KEY = "B"

    Dim t0 As Single: t0 = Timer
    Dim wsTarget As Worksheet, wsCount As Worksheet, wsOutput As Worksheet
    Dim lastrow As Long, i As Long, rowOut As Long
    
    Dim dict As Object, key, ar
    Set dict = CreateObject("Scripting.Dictionary")
    
    Set wsOutput = Sheets("Compare Sheets")
    With wsOutput
        Set wsTarget = Sheets(.Range("C3").Value2)
        Set wsCount = Sheets(.Range("C4").Value2)
    End With
    
    With wsCount
        lastrow = .Cells(.Rows.Count, COL_KEY).End(xlUp).Row
        ar = .Range("B1:B" & lastrow).Value2
        For i = ROW_START To lastrow
            key = Trim(ar(i, 1))
            If dict.exists(key) Then
                MsgBox "Duplicate key '" & key & "'", vbExclamation, wsCount.Name & " Row " & i
            Else
                dict.Add key, i
            End If
        Next
    End With
    
    rowOut = 2
    With wsTarget
        lastrow = .Cells(.Rows.Count, COL_KEY).End(xlUp).Row
        ' FOUND or MISSING
        For i = ROW_START To lastrow
            key = Trim(.Cells(i, COL_KEY))
            
            ' check if col B value exists on wsCount
            If dict.exists(key) Then
                wsOutput.Cells(rowOut, "F") = "FOUND"
                dict(key) = 0 ' mark as found
            Else
                wsOutput.Cells(rowOut, "F") = "MISSING"
            End If
            wsOutput.Cells(rowOut, "G").Resize(, 3) = .Cells(i, COL_KEY).Resize(, 3).Value2
            rowOut = rowOut + 1
        Next
    
        ' ADDITIONAL
        For Each key In dict.keys
           i = dict(key)  ' row on wsCount
           If i > 0 Then
               wsOutput.Cells(rowOut, "F") = "ADDITIONAL"
               wsOutput.Cells(rowOut, "G") = key
               wsOutput.Cells(rowOut, "J") = wsCount.Cells(i, "C").Value2
               rowOut = rowOut + 1
           End If
        Next
    End With
     
    MsgBox lastrow - ROW_START + 1 & " rows scanned on " & wsTarget.Name, _
            vbInformation, Format(Timer - t0, "0.0 secs")
    
End Sub