比较和突出显示VBA中数千行的好方法

问题描述：

我有一些代码，可以将A列中的每个单元格与B列中的所有单元格进行比较，并针对指定的行数执行此操作.

I have code that would compare each cell in column A to everything in column B and do this for the number of lines specified.

当我有几百行时，这很好，但是现在我发现只有2000行，代码只是不会削减它.谁能看看我的代码并告诉我是否要进行一些改进，或者我应该废弃它并以不同的方式进行操作.

This was fine when I had a couple hundred lines, but now I am finding with 2000 lines the code is just not going to cut it. Can anyone look at my code and tell me if there are some improvements to be made or if I should scrap it and do it differently.

Sub highlight()

Dim compare As String
Dim i As Integer
Dim comprange As Range
Dim lines As Integer
i = 2
ScreenUpdating = False

Range("a2").Select
lines = Application.InputBox(Prompt:="How many lines need to be compared?", 
_
Title:="SPECIFY RANGE", Type:=1)

Do Until IsEmpty(ActiveCell)

    If i + 1 > lines Then
        Exit Do
    End If

Set comprange = Range("A" & i)
    comprange.Select
    compare = comprange.Value
    i = i + 1

    Range("B2").Select
        Do Until IsEmpty(ActiveCell.Offset(1, 0))

            If ActiveCell.Value = compare Then
                ActiveCell.Interior.ColorIndex = 37
                ActiveCell.Offset(1, 0).Select
                Exit Do
            Else
                If IsEmpty(ActiveCell.Offset(1, 0)) Then
                    Exit Do
                Else
                ActiveCell.Offset(1, 0).Select
                End If
            End If
        Loop
    Loop
    compare = ActiveCell.Value
    Set comprange = Selection
    Range("a2").Select
    Do Until IsEmpty(ActiveCell.Offset(1, 0))

            If ActiveCell.Value = compare Then
                comprange.Interior.ColorIndex = 37
                ActiveCell.Offset(1, 0).Select
                Exit Do
            Else
                If IsEmpty(ActiveCell.Offset(1, 0)) Then
                    Exit Do
                Else
                ActiveCell.Offset(1, 0).Select
                End If
            End If
        Loop
End Sub

答

尝试此操作，它将检查您在A列中的所有值以及在B列中是否匹配.

Try this, it will check ALL your values in column A and if it matches in column B hightlights.

Sub ok()
    Dim i, i2 As Long
    Dim LastRow, LastRow2 As Long

    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    With ActiveSheet
        LastRow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With

    For i = 1 To LastRow
        For i2 = 1 To LastRow2
            If Range("A" & i).Value = Range("B" & i2).Value Then
                Range("A" & i).Interior.ColorIndex = 37
                Range("B" & i2).Interior.ColorIndex = 37
            End If
        Next
    Next
End Sub

比较和突出显示VBA中数千行的好方法

相关推荐