什么是比较两个Excel表格最好的方法？
我试图通过比较每个单元格的值来比较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 谢谢！
可能最好的方法是将每个表的范围值传递给一个数组。
然后迭代数组中的每个元素。
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.
我没有能够改善代码的其他部分，道歉。
我无法想象你想要完成什么。
希望这可以帮助你一点。