文件由于行范围较大而没有响应？

Question

我有比较两个Excel工作表的这段代码。该代码可以很好地进行较小的比较。我进行了7行2列的测试。

代码本身的工作方式如下，它将两个工作表进行比较并将差异复制到新的工作簿中。

但是，应在大约16列和206700左右有很多行的文件上实现代码。

问题在于，当创建新文件时，该过程开始了，但是可能是因为文件中包含很多行而导致的过载显示“无响应”。我一直在等待大约10分钟，但仍然没有回应。

任何人都可以为此提供帮助或给我建议

Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet)

  Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
  Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String
  Dim report As Workbook, difference As Long
  Dim row As Long, col As Integer

  Set report = Workbooks.Add

  With ws1.UsedRange
    ws1row = .Rows.Count
    ws1col = .Columns.Count
  End With

  With ws2.UsedRange
    ws2row = .Rows.Count
    ws2col = .Columns.Count
  End With

  maxrow = ws1row
  maxcol = ws1col
  If maxrow < ws2row Then maxrow = ws2row
  If maxcol < ws2col Then maxcol = ws2col

  difference = 0

  For col = 1 To maxcol
    For row = 1 To maxrow
      colval1 = ""
      colval2 = ""
      colval1 = ws1.Cells(row, col).Formula
      colval2 = ws2.Cells(row, col).Formula
      If colval1 <> colval2 Then
        difference = difference + 1
        Cells(row, col).Formula = colval1 & "<> " & colval2
        Cells(row, col).Interior.Color = 255
        Cells(row, col).Font.ColorIndex = 2
        Cells(row, col).Font.Bold = True
      End If
    Next row
  Next col

  Columns("A:B").ColumnWidth = 25
  report.Saved = True

  If difference = 0 Then
    report.Close False
  End If
  Set report = Nothing
  MsgBox difference & " cells contain different data! ", vbInformation, _
         "Comparing Two       Worksheets"
End Sub

Answer 1

可以尝试使用“数组比较”来修改代码。使用250000行X 26列随机数据进行了测试。比较大约需要18秒，而完成报告生成又需要22秒，总共需要40秒。报告格式的设计与要求几乎没有什么不同。生成的报告将显示Ws1中的所有行，包含差异的行的字体将为粗体。和具有差异的单元格背景标记为红色。根据行的不同，最右边的列将被设置为true或false，并且可用于过滤掉任何选项。

Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet)
  Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
  Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String
  Dim Report As Workbook, difference As Long
  Dim row As Long, col As Integer
  Dim Arr1 As Variant, Arr2 As Variant, Arr3 As Variant, Rng As Range
  Dim tm As Double, Change As Boolean
  tm = Timer

  'Application.ScreenUpdating = False
  'Application.Calculation = xlCalculationManual
  'Application.EnableEvents = False


  With ws1.UsedRange
    ws1row = .Rows.Count
    ws1col = .Columns.Count
  End With

  With ws2.UsedRange
    ws2row = .Rows.Count
    ws2col = .Columns.Count
  End With

  maxrow = ws1row
  maxcol = ws1col
  If maxrow < ws2row Then maxrow = ws2row
  If maxcol < ws2col Then maxcol = ws2col


  Arr1 = ws1.Range(ws1.Cells(1, 1), ws1.Cells(maxrow, maxcol)).Formula
  Arr2 = ws2.Range(ws2.Cells(1, 1), ws2.Cells(maxrow, maxcol)).Formula
  ReDim Arr3(1 To maxrow, 1 To maxcol + 1)

  difference = 0
  For row = 1 To maxrow
  Change = False
    For col = 1 To maxcol
      If Arr1(row, col) <> Arr2(row, col) Then
      difference = difference + 1
      Change = True
      Arr3(row, col) = Arr1(row, col) & ChrW(9747) & Arr2(row, col) 'Unicode character 9747 used as separator between to different values. it is also used for conditional format later. May use character of your choice
      Else
      Arr3(row, col) = Arr1(row, col)  'May change it to Arr2 as default
      End If
    Next col
  Arr3(row, maxcol + 1) = Change
  Next row

  Debug.Print " Calc secs " & Timer - tm
  If difference > 0 Then
  Set Report = Workbooks.Add

  Dim ColLetter As String
  With Report.ActiveSheet
  ColLetter = Split(.Cells(1, maxcol + 1).Address, "$")(1)
  .Range("A1").Resize(UBound(Arr3, 1), UBound(Arr3, 2)).Value = Arr3
  Set Rng = .Range(Report.ActiveSheet.Cells(1, 1), Report.ActiveSheet.Cells(UBound(Arr3, 1), UBound(Arr3, 2)))
  End With

  With Rng
  .FormatConditions.Add Type:=xlTextString, String:=ChrW(9747), TextOperator:=xlContains _
  .FormatConditions(.FormatConditions.Count).SetFirstPriority
     With .FormatConditions(.FormatConditions.Count)
        .Interior.Color = 255
        .Font.Bold = True
        .Font.ColorIndex = 2
     End With
   .FormatConditions.Add Type:=xlExpression, Formula1:="=AND($" & ColLetter & "1)"
     With .FormatConditions(.FormatConditions.Count)
        .Font.Bold = True
     End With

    'Remove both or one line to filter accordingly
    .AutoFilter Field:=maxcol + 1, Criteria1:="TRUE"
    .AutoFilter Field:=maxcol + 1, Criteria1:="FALSE"


   End With

  Debug.Print "Report Generated secs " & Timer - tm
  End If
 'Set Report = Nothing
  'Application.ScreenUpdating = True
  'Application.Calculation = xlCalculationAutomatic
  'Application.EnableEvents = True

  MsgBox difference & " cells contain different data! ", vbInformation, "Comparing Two       Worksheets"
End Sub

由于我个人不希望保留计算，事件处理和屏幕更新（通常情况下），因此我没有使用该标准行。但是，根据工作文件的情况，您可以使用这些标准技术。

Answer 2

有两种比较两个工作表的实用方法：

  

方法1：电子表格比较工具

此工具与Office套件一起提供。转到开始菜单，然后寻找该图标。也可以使用2013版。

它提供了非常不错的比较，您可以导出结果。如果您也想使该工具自动化，则可以参考此How to script Excel 2013's Spreadsheet Compare?

  

方法2：条件格式

此方法突出显示第一张纸与第二张纸之间的差异。您需要的只是一条条件规则。

并将规则应用于整个工作表。

最后但并非最不重要的一点是，如果它是“大数据”比较，请不要强行使用定制宏进行比较。 VBA宏不是为此而构建的。