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

我可能会建议一些可能有所帮助的调整。

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

Application.ScreenUpdating = False 
'Your loop here'
Application.ScreenUpdating = True

为通过代码重复的表达式使用变量，例如
```
Column1.Rows.Count
```

我还没有测试过，但检查它应该很快;）

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.66秒内100＆＃39,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

比较Excel VBA上的两列

3 个答案: