比较Excel VBA上的两列

我正在寻找比较使用VBA的Excel中的两列。 我正在使用下面的代码，但因为有成千上万的单元格，所以花了很多时间。 我正在寻求把最大的限制，但不知道如何/在哪里应用。 我也不知道是否有人知道更有效的方法来做这个代码？

Private Sub CommandButton1_Click() Dim Column1 As Range Dim Column2 As Range 'Prompt user for the first column range to compare... Set Column1 = Application.InputBox("Select First Column to Compare", Type:=8) 'Check that the range they have provided consists of only 1 column... If Column1.Columns.Count > 1 Then Do Until Column1.Columns.Count = 1 MsgBox "You can only select 1 column" Set Column1 = Application.InputBox("Select First Column to Compare", Type:=8) Loop End If 'Prompt user for the second column range to compare... Set Column2 = Application.InputBox("Select Second Column to Compare", Type:=8) 'Check that the range they have provided consists of only 1 column... If Column2.Columns.Count > 1 Then Do Until Column2.Columns.Count = 1 MsgBox "You can only select 1 column" Set Column2 = Application.InputBox("Select Second Column to Compare", Type:=8) Loop End If 'Check both column ranges are the same size... If Column2.Rows.Count <> Column1.Rows.Count Then Do Until Column2.Rows.Count = Column1.Rows.Count MsgBox "The second column must be the same size as the first" Set Column2 = Application.InputBox("Select Second Column to Compare", Type:=8) Loop End If 'If entire columns have been selected, limit the range sizes If Column1.Rows.Count = 11600 Then Set Column1 = Range(Column1.Cells(1), Column1.Cells(ActiveSheet.UsedRange.Rows.Count)) Set Column2 = Range(Column2.Cells(1), Column2.Cells(ActiveSheet.UsedRange.Rows.Count)) End If 'Perform the comparison and set cells that are the same to yellow Dim intCell As Long For intCell = 1 To Column1.Rows.Count If Column1.Cells(intCell) = Column2.Cells(intCell) Then Column1.Cells(intCell).Interior.Color = vbYellow Column2.Cells(intCell).Interior.Color = vbYellow End If Next End Sub 

谢谢。

Answer 1

我可能会build议一些调整，可以帮助。

1. 比较循环运行时禁用屏幕更新。 你可以这样做：

     Application.ScreenUpdating = False 
    '你的循环在这里'
    Application.ScreenUpdating = True 

2. 对通过代码重复的expression式使用variables，如

     Column1.Rows.Count 

我没有testing它，但它应该是相当快的检查出来;）

Answer 2

屏幕更新是一个巨大的CPU吸盘，尤其是当你改变单元格的颜色。 所以@ zfdn.cat的答案肯定会帮助你。

另一个想法，虽然：如果你的10000行的许多行正在改变颜色，你也会看到一个性能增加，跟踪哪些单元格需要改变颜色，并设置这些单元格的颜色，一旦你的循环完成。

就像是…

 Dim range_string as String range_string = "" Dim intCell As Long For intCell = 1 To Column1.Rows.Count If Column1.Cells(intCell) = Column2.Cells(intCell) Then ' check if the range_string is empty ' if not, we'll add a comma to separate the next and previous points if range_string <> "" Then range_string = range_string & "," end if range_string = range_string & _ Column1.Cells(intCell).Address & ":" &_ Column1.Cells(intCell).Address & "," & _ Column2.Cells(intCell).Address & ":" &_ Column2.Cells(intCell).Address End If Next ' Change the color of all the cells at once Range(range_string).Interior.Color = vbYellow 

我还没有testing过这个代码，但algorithm是稳定的…我想

Answer 3

你可以试试（13,46秒内100000行）：

  Sub Main() Dim Col1 As Range Dim Col2 As Range Dim wb As Workbook Dim ws As Worksheet Dim i As Long Set wb = ThisWorkbook Set ws = wb.Sheets("Sheet1") ' Change the name of your Sheet Set Col1 = Application.InputBox("Select First Column to Compare", Type:=8) Set Col2 = Application.InputBox("Select First Column to Compare", Type:=8) Application.ScreenUpdating = False With ws i = 1 Do While Not IsEmpty(.Cells(i, Col1.Column)) If .Cells(i, Col1.Column) = .Cells(i, Col2.Column) Then .Cells(i, Col1.Column).Interior.Color = vbYellow .Cells(i, Col2.Column).Interior.Color = vbYellow End If i = i + 1 Loop End With Application.ScreenUpdating = True End Sub