比较两张excel表格的最佳方法是什么？

Question

我想通过比较每个单元格的值来比较vba中的两个excel表单。有没有提高性能的最佳方法？

当我有超过2000到3000行在我的Excel表。它需要大约5分钟执行。有什么办法来优化这个代码？

Sub CompareWorksheets(WS1 As Worksheet, WS2 As Worksheet) 

Dim dR As Boolean 
Dim r As Long, c As Integer, m As Integer 
Dim lrow1 As Long, lrow2 As Long, lrow3 As Long 
Dim lcoloumn1 As Integer, lcoloumn2 As Integer, 
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String 
Dim dupCount As Long 

With WS1.UsedRange 
    lrow1 = .Rows.Count 
    lcoloumn1 = .Columns.Count 
End With 

With ws2.UsedRange 
    lrow2 = .Rows.Count 
    lcoloumn2 = .Columns.Count 
End With 

maxR = lrow1 
maxC = lcoloumn1 

If maxR < lrow2 Then maxR = lrow2 
If maxC < lcoloumn2 Then maxC = lcoloumn2 
DiffCount = 0 
lrow3 = 1 

For i = 1 To maxR 
    dR = True 
    Application.StatusBar = "Comparing worksheets " & Format(i/maxR, "0 %") & "..." 
    For r = 1 To maxR 
     For c = 1 To maxC 
      WS1.Select 
      cf1 = "" 
      cf2 = "" 
      On Error Resume Next 
      cf1 = WS1.Cells(i, c).FormulaLocal 
      cf2 = ws2.Cells(r, c).FormulaLocal 
      On Error GoTo 0 
      If cf1 <> cf2 Then 
       dR = False 
       Exit For 
      Else 
       dR = True 
      End If 
     Next c 
     If dR Then 
     Exit For 
     End If 
    Next r 
    If Not dR Then 
     dupCount = dupCount + 1 
     WS1.Range(WS1.Cells(i, 1), WS1.Cells(i, maxC)).Select 
     Selection.Copy 
     Worksheets("Sheet3").Select 
     Worksheets("Sheet3").Range(Worksheets("Sheet3").Cells(lrow3, 1), Worksheets ("Sheet3").Cells(lrow3, maxC)).Select 
     Selection.PasteSpecial 
     lrow3 = lrow3 + 1 
     WS1.Select 
     For t = 1 To maxC 
      WS1.Cells(i, t).Interior.ColorIndex = 19 
      WS1.Cells(i, t).Select 
      Selection.Font.Bold = True 
     Next t 
    End If 
    Next i 
End Sub 

谢谢！

Answer 1

可能最好的方法是将每张纸的范围值传递给一个数组。
然后迭代该数组的每个元素。

Sub test2() 

Dim arr1(), arr2() As Variant 
Dim i, j As Long 

arr1 = Sheets("Sheet1").Range("A1:D4").Value 
arr2 = Sheets("Sheet2").Range("A1:D4").Value 

For i = 1 To UBound(arr1, 1) 
    For j = 1 To UBound(arr1, 2) 
     If arr1(i, j) = arr2(i, j) Then 'do the comparison here 
      'code here 
     End If 
    Next j 
Next i 

End Sub 

上述代码仅用于相同的范围比较。
否则，您需要添加另一个循环。
希望这会让你开始。

更新：
下面是细胞的公式比较你的代码的部分的等效。

Dim arr1(), arr2() As Variant 

Set WS1 = ThisWorkbook.Sheets("Sheet1") 
Set WS2 = ThisWorkbook.Sheets("Sheet2") 

arr1 = WS1.UsedRange.FormulaLocal 
arr2 = WS1.UsedRange.FormulaLocal 

lrow1 = UBound(arr1, 1) 
lrow2 = UBound(arr2, 1) 
lcolumn1 = UBound(arr1, 2) 
lcolumn2 = UBound(arr2, 2) 

maxR = lrow1 
maxC = lcoloumn1 

If maxR < lrow2 Then maxR = lrow2 
If maxC < lcoloumn2 Then maxC = lcoloumn2 

DiffCount = 0 
lrow3 = 1 

For i = 1 To maxR 
    dR = True 
    Application.StatusBar = "Comparing worksheets " & Format(i/maxR, "0 %") & "..." 
    For r = 1 To maxR 
     For c = 1 To maxC 
      cf1 = "" 
      cf2 = "" 
      On Error Resume Next 
      cf1 = arr1(i, c) 
      cf2 = arr2(r, c) 
      On Error GoTo 0 
      If cf1 <> cf2 Then 
       dR = False 
       Exit For 
      Else 
       dR = True 
      End If 
     Next c 
     If dR Then 
      Exit For 
     End If 
    Next r 
'the rest of your code goes here which i cannot comprehend. 

我无法改善代码的其他部分，道歉。
我无法想象你想要完成什么。
希望这可以帮助你一点。