我创建了一个宏,用于比较不同工作表中的两列,并使用绿色突出显示匹配的单元格
但是如果我使用这个
那么两列都超过了9000行的问题for i =1 to lastrow
匹配值超过5分钟并给出结果
Dim i As Variant, j As Integer, k As Integer
'lastRow = Sheets(1).Range("A1").End(xlDown).Row
'lastrow1 = Sheets(2).Range("A1").End(xlDown).Row
lastRow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
lastRow1 = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
For i = 8 To 9252
If Sheets(1).Cells(i, 1).Value <> "" Then
For j = 1 To 9252
If Sheets(1).Cells(i, 4).Value = Sheets(2).Cells(j, 1).Value Then
Sheets(1).Cells(i, 4).Interior.ColorIndex = 4
End If
Next j
Else
i = i + 1
End If
Next i
我想要的是找到一个使用Lastrow比较两列的解决方案,找到一个没有延迟的有效解决方案
有人对此有所了解吗?
最诚挚的问候 珀勒什
答案 0 :(得分:2)
您只想在Sheet2上找到Sheet1的值;如果Sheet2上有多个匹配值,则无关紧要。 Application.Match将比循环遍历所有行更快地定位相同的值。
dim i as long, f as variant
with workSheets(1)
for i=8 to .Cells(.Rows.Count, "A").End(xlUp).Row
f = application.match(.cells(i, "A").value2, workSheets(2).columns("A"), 0)
if not iserror(f) then
.cells(i, "A").Interior.ColorIndex = 4
end if
next i
end with
使用原始的双循环,即使在Sheet2的第10行中找到Sheet1的值,您仍然会通过循环进行比较直到第9252行.Pheet1中的单元格只能着色一次。
答案 1 :(得分:1)
一种方法是使用字典作为设置数据结构来保存工作表2中的值,然后在工作表1中使用此字典。这将具有将二次算法更改为线性算法的效果:
Sub ColorMatches()
Dim i As Long
Dim lastRow As Long
Dim R As Range, cl As Range
Dim D As Object
Dim vals As Variant
'load dictionary from sheet 2
Set D = CreateObject("Scripting.Dictionary")
lastRow = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
vals = Sheets(2).Range("A8:A" & lastRow).Value
For i = LBound(vals) To UBound(vals)
If Not D.exists(vals(i, 1)) Then D.Add vals(i, 1), 0
Next i
'use dictionary in sheet 1
lastRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Set R = Sheets(1).Range("A1:A" & lastRow)
For Each cl In R.Cells
If D.exists(cl.Value) Then cl.Interior.ColorIndex = 4
Next cl
End Sub
作为一个小但可能很重要的一点:请注意我使用Long
代替i
而不是Integer
代表行索引(正如您在代码中所做的那样)。现代版本的Excel拥有的行数多于Integer
变量所能表示的行数,而16位整数可能会使用32位存储,因此使用Integer
只会冒出溢出而没有相应的增益。< / p>
答案 2 :(得分:0)
我相信这应该可以解决问题。我不是专家,但是从困难的方式学到了一个简单的教训:你与纸张的互动越少,它的工作就越快!
Option Explicit 'Is worth using this option, so you remember declaring your variables
Sub SO()
Dim i As Long, j As Long, k As Long
Dim arrRange1 As Variant, arrRange2 As Variant, arrColor As Variant 'Declare arrays
ReDim arrColor(0) 'Initial redim
Dim lastRow As Long 'Only need to use one variable for this, and reassign as needed through the code
Dim sh1 As Worksheet: Set sh1 = ThisWorkbook.Sheets("RandomSheetName 1") 'Declare sheet 1
Dim sh2 As Worksheet: Set sh2 = ThisWorkbook.Sheets("RandomSheetName 2") 'Declare sheet 2
With sh1
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'Get last row from sheet 1 in column "A"
arrRange1 = .Range(.Cells(8, 4), .Cells(lastRow, 4)) 'Get all values from column "D", starting at row 8
End With
With sh2
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'Get last row from sheet 2 in column "A"
arrRange2 = .Range(.Cells(1, 1), .Cells(lastRow, 1)) 'Get all values from column "A", starting at row 1
End With
For i = LBound(arrRange1) To UBound(arrRange1) 'Loop through first sheet values
If arrRange1(i, 1) <> "" Then 'If not empty, then...
For j = LBound(arrRange2) To UBound(arrRange2) 'Loop through second sheet values
If arrRange1(i, 1) = arrRange2(j, 1) Then 'If match, then...
ReDim Preserve arrColor(k) 'Redim (preserve) the colours array
arrColor(k) = i + 7 'Add the value of i in the colours array (note +7, since yours sheet1 values start at row 8, feel free to amend)
k = k + 1 'Increase the counter for the colours array
Exit For 'As per idea from the accepted response, no point to check the whole sheet2 range if duplicate found already
End If
Next j
End If
Next i
Application.ScreenUpdating = False 'It always helps to turn off the screenupdating when working with the sheets
For i = LBound(arrColor) To UBound(arrColor) 'Loop through the colours array
If arrColor(0) = "" Then Exit For 'If the first element is empty, means no matches... exit here.
sh1.Cells(arrColor(i), 4).Interior.ColorIndex = 4 'Colour the cell as needed using the value we previously stored
Next i
Application.ScreenUpdating = True 'And lets not forget to turn it on again
End Sub
PS:请注意,Rows.Count
它会从ActiveSheet
开始计算,而非来自Sheet1
或Sheet2
。您需要完整引用,即:Sheets(1).Rows.Count
所以这个:
lastRow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
应该是
lastRow = Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row
或
With Sheets(1)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
希望这有帮助!