比較兩張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. 

我無法改善代碼的其他部分，道歉。
我無法想象你想要完成什麼。
希望這可以幫助你一點。