比较Excel VBA上的两列

Question

我想使用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

我可能会提出一些可能有所帮助的调整。

1. 在比较循环运行时禁用屏幕更新。 您可以执行以下操作：

     Application.ScreenUpdating = False \n “您的循环在这里”\n Application.ScreenUpdating =真 

2. 将变量用于在代码中重复的表达式，例如

     列1.行数 

我没有测试过，但是检查出来应该很快；）

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

我没有测试代码，但是算法很可靠...我认为

Answer 3

您可以尝试以下操作（在13,46秒内完成100'000行）：

 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