我剛開始玩使用VBA努力尋找方法來檢查兩個Excel sheets.I走到低谷所有的答案，我可以在這里找到有關Excel中使用VBA比較表終于找到這個答案 VBA -比較表2個表而不同 ，從[R .Katnaan給出了最好的結果。所以我正在嘗試根據我的情況調整和實施它。作業表是目標和計數結果的輸出表。這些作業表會根據我選擇的輸出作業表中的參考動態更改，其中用戶通過下拉串列決定要檢查的檔案。代碼始終在兩個作業表目標和計數上檢查 b 列的起始行 3。
該代碼正在作業，但對于大表（超過 100 行），它需要很長時間。例如，對于 3500 行的作業表，需要 3 分 45 秒才能得出結果并且上面有錯誤（結果丟失）。我猜是 do while 函式，但我不確定。有沒有辦法優化代碼？提前感謝您的時間。
Public Sub Compare_sheets()
Dim targetSheet, countingSheet, outputSheet As Worksheet
Dim startrow, outputRow, temptargetRow, tempcountingRow, countingRowCount, targetRowCount, totalRowCount, finishedcountingIndex As Integer
Dim finishedcounting() As String
Dim isExist As Boolean
'Do in background
Application.ScreenUpdating = False
Application.EnableEvents = False
'Set sheets
Set targetSheet = Sheets(Sheets("Compare Sheets").Range("C3").Value)
Set countingSheet = Sheets(Sheets("Compare Sheets").Range("C4").Value)
Set outputSheet = Sheets("Compare Sheets")
'Set start row of each sheet for data
startrow = 3
outputRow = 2
'Get row count from counting sheet and targetsheet
countingRowCount = countingSheet.Range("b" & startrow).End(xlDown).Row
targetRowCount = targetSheet.Range("b" & startrow).End(xlDown).Row
'Check which is bigger
If countingRowCount < targetRowCount Then
totalRowCount = targetRowCount
Else
totalRowCount = countingRowCount
End If
'Set index
finishedcountingIndex = 0
'Re-define array
ReDim finishedcounting(0 To totalRowCount - 1)
'Set the start row
temptargetRow = startrow
'Here I looped with OR state, you can modify it to AND start if you want
Do
'Reset exist flag
isExist = False
'loop all row in counting sheet
For tempcountingRow = 1 To totalRowCount Step 1
'If row is not finished for checking.
If UBound(Filter(finishedcounting, tempcountingRow)) < 0 Then
'If all cell are equal
If targetSheet.Range("b" & temptargetRow) = countingSheet.Range("b" & tempcountingRow) Then
'Set true to exist flag
isExist = True
'Store finished row
finishedcounting(finishedcountingIndex) = tempcountingRow
finishedcountingIndex = finishedcountingIndex 1
'exit looping
Exit For
End If
End If
Next tempcountingRow
'Show result
outputSheet.Range("g" & outputRow) = targetSheet.Range("b" & temptargetRow)
outputSheet.Range("h" & outputRow) = targetSheet.Range("c" & temptargetRow)
outputSheet.Range("i" & outputRow) = targetSheet.Range("d" & temptargetRow)
If isExist Then
outputSheet.Range("f" & outputRow) = "FOUND"
Else
outputSheet.Range("f" & outputRow) = "MISSING"
End If
'increase output row
outputRow = outputRow 1
'go next row
temptargetRow = temptargetRow 1
Loop While targetSheet.Range("B" & temptargetRow) <> vbNullString ' Or targetSheet.Range("B" & temptargetRow) <> "" Or targetSheet.Range("C" & temptargetRow) <> ""
'loop all row in counting sheet
For tempcountingRow = 1 To totalRowCount Step 1
'If row is not finished for checking.
If UBound(Filter(finishedcounting, tempcountingRow)) < 0 Then
'Show result
outputSheet.Range("g" & outputRow) = countingSheet.Range("b" & tempcountingRow)
outputSheet.Range("j" & outputRow) = countingSheet.Range("c" & tempcountingRow)
'outputSheet.Range("C" & outputRow) = countingSheet.Range("C" & tempcountingRow)
outputSheet.Range("f" & outputRow) = "ADDITIONAL"
'increase output row
outputRow = outputRow 1
End If
Next tempcountingRow
'Update
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
uj5u.com熱心網友回復：
使用字典物件。
Option Explicit
Public Sub Compare_sheets2()
Const ROW_START = 3
Const COL_KEY = "B"
Dim t0 As Single: t0 = Timer
Dim wsTarget As Worksheet, wsCount As Worksheet, wsOutput As Worksheet
Dim lastrow As Long, i As Long, rowOut As Long
Dim dict As Object, key, ar
Set dict = CreateObject("Scripting.Dictionary")
Set wsOutput = Sheets("Compare Sheets")
With wsOutput
Set wsTarget = Sheets(.Range("C3").Value2)
Set wsCount = Sheets(.Range("C4").Value2)
End With
With wsCount
lastrow = .Cells(.Rows.Count, COL_KEY).End(xlUp).Row
ar = .Range("B1:B" & lastrow).Value2
For i = ROW_START To lastrow
key = Trim(ar(i, 1))
If dict.exists(key) Then
MsgBox "Duplicate key '" & key & "'", vbExclamation, wsCount.Name & " Row " & i
Else
dict.Add key, i
End If
Next
End With
rowOut = 2
With wsTarget
lastrow = .Cells(.Rows.Count, COL_KEY).End(xlUp).Row
' FOUND or MISSING
For i = ROW_START To lastrow
key = Trim(.Cells(i, COL_KEY))
' check if col B value exists on wsCount
If dict.exists(key) Then
wsOutput.Cells(rowOut, "F") = "FOUND"
dict(key) = 0 ' mark as found
Else
wsOutput.Cells(rowOut, "F") = "MISSING"
End If
wsOutput.Cells(rowOut, "G").Resize(, 3) = .Cells(i, COL_KEY).Resize(, 3).Value2
rowOut = rowOut 1
Next
' ADDITIONAL
For Each key In dict.keys
i = dict(key) ' row on wsCount
If i > 0 Then
wsOutput.Cells(rowOut, "F") = "ADDITIONAL"
wsOutput.Cells(rowOut, "G") = key
wsOutput.Cells(rowOut, "J") = wsCount.Cells(i, "C").Value2
rowOut = rowOut 1
End If
Next
End With
MsgBox lastrow - ROW_START 1 & " rows scanned on " & wsTarget.Name, _
vbInformation, Format(Timer - t0, "0.0 secs")
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/369562.html
下一篇：在表格中的選定行上方插入一行