[英]Compare two column in differents worksheets
我創建了一個宏來比較不同工作表中的兩列,並用綠色突出顯示匹配的單元格
但是如果我使用這個,那么兩列都超過了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比較兩列,找到一個沒有延遲的有效解決方案
有人對此有所了解嗎?
最好的問候Polos
您只想在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中的單元格只能着色一次。
一種方法是使用字典作為設置數據結構來保存工作表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
for i
而不是Integer
來獲取行索引(就像你在代碼中所做的那樣)。 現代版本的Excel具有的行數多於可由Integer
變量表示的行數,而16位整數可能使用32位存儲,因此使用Integer
只會冒溢出而沒有相應的增益。
我相信這應該可以解決問題。 我不是專家,但是從一個簡單的教訓中學到了很多東西: 你與紙張的互動越少,它的工作就越快!
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
希望這可以幫助!
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.