I have a single sheet with 7800 Rows by 2382 columns approx. (19.5Million Cells)
我有一张7800行的单张纸，大约2382列。 （19.5万亿个细胞）
Out of this I have 22 x columns I am actually interest in, which have 5 x digit numbers scatted within them.
除此之外，我有22个我感兴趣的列，其中有5个数字的数字。
Essentially if a number in the first of the columns is then found in any of the other 21 x columns I want to turn the relevant rows, columns A cell interior RED.
基本上，如果在其他21 x列中的任何一列中找到第一列中的数字，我想要转换相关行，列A单元格内部为RED。
I have got this working, I believe with the attached code, but it takes around 3 x hours to run.
我有这个工作，我相信所附的代码，但运行大约需要3个小时。
I would like to ask firstly, is this a reasonable amount of time (3 x Hours) with the size of the spreadsheet?
我想先问一下，这是一个合理的时间（3 x小时）与电子表格的大小？
If you would expect the routine to be a lot quicker, I would really appreciate your guidance on how it should be scripted.
如果您希望例行程序更快，我将非常感谢您对如何编写脚本的指导。
Sub FindMatch()
Dim rng_1 As Range
Dim rng_2 As Range
Dim rng_3 As Range
Dim rng_4 As Range
Dim rng_5 As Range
Dim rng_6 As Range
Dim rng_7 As Range
Dim rng_8 As Range
Dim rng_9 As Range
Dim rng_10 As Range
Dim rng_11 As Range
Dim rng_12 As Range
Dim rng_13 As Range
Dim rng_14 As Range
Dim rng_15 As Range
Dim rng_16 As Range
Dim rng_17 As Range
Dim rng_18 As Range
Dim rng_19 As Range
Dim rng_20 As Range
Dim rng_21 As Range
Dim rng_22 As Range
Dim rngRef_1 As Range
Dim rngRef_2 As Range
Dim rngRef_3 As Range
Dim rngRef_4 As Range
Dim rngRef_5 As Range
Dim rngRef_6 As Range
Dim rngRef_7 As Range
Dim rngRef_8 As Range
Dim rngRef_9 As Range
Dim rngRef_10 As Range
Dim rngRef_11 As Range
Dim rngRef_12 As Range
Dim rngRef_13 As Range
Dim rngRef_14 As Range
Dim rngRef_15 As Range
Dim rngRef_16 As Range
Dim rngRef_17 As Range
Dim rngRef_18 As Range
Dim rngRef_19 As Range
Dim rngRef_20 As Range
Dim rngRef_21 As Range
Dim rngRef_22 As Range
Application.Calculation = xlManual
Application.ScreenUpdating = False
Set rng_1 = Worksheets("Sheet1").Range("$DQ$2:$DQ$8000")
Set rng_2 = Worksheets("Sheet1").Range("$GW$2:$GW$8000")
Set rng_3 = Worksheets("Sheet1").Range("$KC$2:$KC$8000")
Set rng_4 = Worksheets("Sheet1").Range("$NI$2:$NI$8000")
Set rng_5 = Worksheets("Sheet1").Range("$QO$2:$QO$8000")
Set rng_6 = Worksheets("Sheet1").Range("$TU$2:$TU$8000")
Set rng_7 = Worksheets("Sheet1").Range("$XA$2:$XA$8000")
Set rng_8 = Worksheets("Sheet1").Range("$AAG$2:$AAG$8000")
Set rng_9 = Worksheets("Sheet1").Range("$ADM$2:$ADM$8000")
Set rng_10 = Worksheets("Sheet1").Range("$AGS$2:$AGS$8000")
Set rng_11 = Worksheets("Sheet1").Range("$AJY$2:$AJY$8000")
Set rng_12 = Worksheets("Sheet1").Range("$ANE$2:$ANE$8000")
Set rng_13 = Worksheets("Sheet1").Range("$AQK$2:$AQK$8000")
Set rng_14 = Worksheets("Sheet1").Range("$ATQ$2:$ATQ$8000")
Set rng_15 = Worksheets("Sheet1").Range("$AWW$2:$AWW$8000")
Set rng_16 = Worksheets("Sheet1").Range("$BAC$2:$BAC$8000")
Set rng_17 = Worksheets("Sheet1").Range("$BDI$2:$BDI$8000")
Set rng_18 = Worksheets("Sheet1").Range("$BGO$2:$BGO$8000")
Set rng_19 = Worksheets("Sheet1").Range("$BJU$2:$BJU$8000")
Set rng_20 = Worksheets("Sheet1").Range("$BNA$2:$BNA$8000")
Set rng_21 = Worksheets("Sheet1").Range("$BQG$2:$BQG$8000")
Set rng_22 = Worksheets("Sheet1").Range("$BTM$2:$BTM$8000")
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_2 In rng_2
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_2.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_3 In rng_3
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_3.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_4 In rng_4
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_4.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_5 In rng_5
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_5.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_6 In rng_6
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_6.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_7 In rng_7
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_7.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_8 In rng_8
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_8.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_9 In rng_9
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_9.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_10 In rng_10
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_10.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_11 In rng_11
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_11.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_12 In rng_12
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_12.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_13 In rng_13
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_13.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_14 In rng_14
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_14.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_15 In rng_15
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_15.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_16 In rng_16
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_16.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_17 In rng_17
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_17.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_18 In rng_18
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_18.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_19 In rng_19
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_19.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_20 In rng_20
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_20.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_21 In rng_21
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_21.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
For Each rngRef_1 In rng_1
For Each rngRef_22 In rng_22
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_22.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
Rem -----------------------------------------------------
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
1 个解决方案
#1
2
To make things faster you can change your code
为了加快速度，您可以更改代码
For Each rngRef_1 In rng_1
For Each rngRef_2 In rng_2
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_2.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
to
至
For Each rngRef_1 In rng_1
If Application.WorksheetFunction.CountIf(rng_2, rngRef_1.Value) > 0 Then _
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
Next
Similarly for others. This avoids looping and checks for the duplicate using the CountIf Formula.
其他人也一样。这样可以避免使用CountIf公式循环并检查副本。
NOTE: To make your existing code faster without using the above suggested method, add Exit For right after rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0). After a match is found, no point in checking further. Similarly for the others.
注意：要在不使用上述建议方法的情况下加快现有代码的速度，请在rngRef_1.Offset（0，-120）之后添加Exit For .Interior.Color = RGB（255,0,0）。找到匹配后，没有必要进一步检查。同样适用于其他人。
Further Optimization: I spent some time reading your code and I noticed something. Your code consists of 283 lines which can be reduced to just 53 lines :)
进一步优化：我花了一些时间阅读你的代码，我发现了一些东西。您的代码由283行组成，可以减少到只有53行:)
The trick is to identify a pattern in your code. Your compare range starts from Col DQ and goes up till column BTM The difference between each range is 84 columns i.e
诀窍是识别代码中的模式。您的比较范围从Col DQ开始，一直到BTM列。每个范围之间的差异是84列，即
GW = 205
NI = 373
and so on...
BTM = 1885
So all we have to do now is construct the next range in a loop rather than predefining it. Also instead of coloring the cell in a loop we are doing it outside the loop. This will also speed things up :)
所以我们现在要做的就是在循环中构造下一个范围而不是预定义它。而不是在循环中着色单元格，我们在循环之外进行。这也会加快速度:)
New Code (Untested)
新守则（未经测试）
Option Explicit
Sub FindMatch()
Dim ws As Worksheet
Dim rng As Range, rngRef As Range, aCell As Range, colorMyRange As Range
Dim nCalc As Long, i As Long
On Error GoTo Whoa
Set ws = ThisWorkbook.Sheets("Sheet1")
With Application
nCalc = .Calculation
.Calculation = xlManual
.ScreenUpdating = False
End With
With ws
Set rng = .Range("$DQ$2:$DQ$8000")
For i = 205 To 1885 Step 84
Set rngRef = .Range(.Cells(2, i), .Cells(8000, i))
For Each aCell In rng
If Application.WorksheetFunction.CountIf(rngRef, aCell.Value) > 0 Then
If colorMyRange Is Nothing Then
Set colorMyRange = aCell.Offset(0, -120)
Else
Set colorMyRange = Union(colorMyRange, aCell.Offset(0, -120))
End If
End If
Next
If Not colorMyRange Is Nothing Then
colorMyRange.Interior.Color = RGB(255, 0, 0)
Set colorMyRange = Nothing
End If
Next i
End With
LetsContinue:
With Application
.Calculation = nCalc
.ScreenUpdating = True
End With
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
#1
2
To make things faster you can change your code
为了加快速度，您可以更改代码
For Each rngRef_1 In rng_1
For Each rngRef_2 In rng_2
If rngRef_1.Value <> "" Then
If rngRef_1.Value = rngRef_2.Value Then
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
End If
End If
Next
Next
to
至
For Each rngRef_1 In rng_1
If Application.WorksheetFunction.CountIf(rng_2, rngRef_1.Value) > 0 Then _
rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
Next
Similarly for others. This avoids looping and checks for the duplicate using the CountIf Formula.
其他人也一样。这样可以避免使用CountIf公式循环并检查副本。
NOTE: To make your existing code faster without using the above suggested method, add Exit For right after rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0). After a match is found, no point in checking further. Similarly for the others.
注意：要在不使用上述建议方法的情况下加快现有代码的速度，请在rngRef_1.Offset（0，-120）之后添加Exit For .Interior.Color = RGB（255,0,0）。找到匹配后，没有必要进一步检查。同样适用于其他人。
Further Optimization: I spent some time reading your code and I noticed something. Your code consists of 283 lines which can be reduced to just 53 lines :)
进一步优化：我花了一些时间阅读你的代码，我发现了一些东西。您的代码由283行组成，可以减少到只有53行:)
The trick is to identify a pattern in your code. Your compare range starts from Col DQ and goes up till column BTM The difference between each range is 84 columns i.e
诀窍是识别代码中的模式。您的比较范围从Col DQ开始，一直到BTM列。每个范围之间的差异是84列，即
GW = 205
NI = 373
and so on...
BTM = 1885
So all we have to do now is construct the next range in a loop rather than predefining it. Also instead of coloring the cell in a loop we are doing it outside the loop. This will also speed things up :)
所以我们现在要做的就是在循环中构造下一个范围而不是预定义它。而不是在循环中着色单元格，我们在循环之外进行。这也会加快速度:)
New Code (Untested)
新守则（未经测试）
Option Explicit
Sub FindMatch()
Dim ws As Worksheet
Dim rng As Range, rngRef As Range, aCell As Range, colorMyRange As Range
Dim nCalc As Long, i As Long
On Error GoTo Whoa
Set ws = ThisWorkbook.Sheets("Sheet1")
With Application
nCalc = .Calculation
.Calculation = xlManual
.ScreenUpdating = False
End With
With ws
Set rng = .Range("$DQ$2:$DQ$8000")
For i = 205 To 1885 Step 84
Set rngRef = .Range(.Cells(2, i), .Cells(8000, i))
For Each aCell In rng
If Application.WorksheetFunction.CountIf(rngRef, aCell.Value) > 0 Then
If colorMyRange Is Nothing Then
Set colorMyRange = aCell.Offset(0, -120)
Else
Set colorMyRange = Union(colorMyRange, aCell.Offset(0, -120))
End If
End If
Next
If Not colorMyRange Is Nothing Then
colorMyRange.Interior.Color = RGB(255, 0, 0)
Set colorMyRange = Nothing
End If
Next i
End With
LetsContinue:
With Application
.Calculation = nCalc
.ScreenUpdating = True
End With
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub