如果有人知道如何更快地完成以下任务,我将不胜感激。我在 A 列中有一个姓名列表,我想看看这些姓名中是否有任何姓名出现在 C 列中。当我用 500 个姓名测试时,下面的代码运行良好。但是当我使用 A 列中有大约 3000 个值、C 列中有 150000 个值的完整数据时,我不确定它是否运行正常,因为已经快两个小时了,它还没有完成。
Sub compare_cols122()
Dim NameList As Worksheet
Dim i As Long, j As Long
Dim LastRow As Long
Set NameList = Excel.Worksheets("Names")
LastRow = NameList.UsedRange.Rows.Count
Application.ScreenUpdating = False
For i = 2 To LastRow
For j = 2 To LastRow
If NameList.Cells(i, 1).Value <> "" Then
If InStr(1, NameList.Cells(j, 3).Value, NameList.Cells(i, 1).Value, vbTextCompare) > 0 Then
NameList.Cells(j, 3).Interior.ColorIndex = 6
NameList.Cells(i, 1).Interior.ColorIndex = 6
Exit For
Else
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
答案1
以下是通过将数据加载到数组中并与它们进行比较来加速的代码:
Sub compare_cols122()
Dim NameList As Worksheet
Dim i As Long, j As Long
Set NameList = Excel.Worksheets("Names")
Dim rngNames As Range
Set rngNames = Range("A1", Range("A1").Offset(Rows.Count - 1).End(xlUp))
Dim varNames As Variant
varNames = rngNames.Value2
Dim rngData As Range
Set rngData = Range("C1", Range("C1").Offset(Rows.Count - 1).End(xlUp))
Dim varData As Variant
varData = rngData.Value2
Application.ScreenUpdating = False
For i = LBound(varNames) + 1 To UBound(varNames)
For j = LBound(varData) + 1 To UBound(varData)
If varNames(i, 1) <> "" Then
If InStr(1, varData(j, 1), varNames(i, 1), vbTextCompare) > 0 Then
NameList.Cells(j, 3).Interior.ColorIndex = 6
NameList.Cells(i, 1).Interior.ColorIndex = 6
Exit For
Else
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
请注意,无论匹配多么罕见,交换内循环和外循环只会减慢搜索速度。
答案2
一遍又一遍地从单元格读取数据是低效的。
使用数组加载所有值。
然后对数组执行您需要执行的操作。
当一切完成后,将值放回单元格中。