我是 VBA 新手，實際上不知道如何處理該任務。也許你可以幫助我。
我有兩張桌子在兩張紙上。表 1 中的表格每天更新。
我需要做的是檢查 A 列（表 1）中的任何值是否在 A 列（表 2）中。如果是，那么什么也不做。如果不是，則將整行復制到作業表 2 的表格中。
根據谷歌結果，我開始撰寫一些代碼，但我卡住了。
Dim source As Worksheet
Dim finaltbl As Worksheet
Dim rngsource As Range
Dim rngfinaltbl As Range
'Set Workbook
Set source = ThisWorkbook.Worksheets("Sheet 1")
Set finaltbl = ThisWorkbook.Worksheets("Sheet 2")
'Set Column
Set rngsource = source.Columns("A")
Set rngfinaltbl = finaltbl.Columns("A")
我假設接下來我需要撰寫一些回圈，但我真的不知道它是如何作業的。
uj5u.com熱心網友回復：
更新缺少（唯一）行的作業表（字典）
- 調整常量部分中的值。
Sub UpdateData()
' Source
Const sName As String = "Sheet1"
Const sFirstCellAddress As String = "A2"
' Destination
Const dName As String = "Sheet2"
Const dFirstCellAddress As String = "A2"
' Reference the destination worksheet.
Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets(dName)
Dim drg As Range
Dim dCell As Range
Dim drCount As Long
' Reference the destination data range.
With dws.Range(dFirstCellAddress)
Set dCell = .Resize(dws.Rows.Count - .Row 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If dCell Is Nothing Then Exit Sub ' no data in column range
drCount = dCell.Row - .Row 1
Set drg = .Resize(drCount)
End With
Dim Data As Variant
' Write the values from the destination range to an array.
If drCount = 1 Then
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = drg.Value
Else
Data = drg.Value
End If
' Write the unique values from the array to a dictionary.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Key As Variant
Dim dr As Long
For dr = 1 To drCount
Key = Data(dr, 1)
If Not IsError(Key) Then ' exclude errors
If Len(Key) > 0 Then ' exclude blanks
dict(Key) = Empty
End If
End If
Next dr
' Reference the source worksheet.
Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets(sName)
Dim srg As Range
Dim sCell As Range
Dim srCount As Long
' Reference the source data range.
With sws.Range(sFirstCellAddress)
Set sCell = .Resize(sws.Rows.Count - .Row 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If sCell Is Nothing Then Exit Sub ' no data in column range
srCount = sCell.Row - .Row 1
Set srg = .Resize(srCount)
End With
' Write the values from the source range to an array.
If srCount = 1 Then
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = srg.Value
Else
Data = srg.Value
End If
Dim surg As Range
Dim sr As Long
' Loop through the source values...
For sr = 1 To srCount
Key = Data(sr, 1)
If Not IsError(Key) Then ' exclude errors
If Len(Key) > 0 Then ' exclude blanks
If Not dict.Exists(Key) Then ' if source value doesn't exist...
dict(Key) = Empty ' ... add it (to the dictionary)...
If surg Is Nothing Then ' and combine the cell into a range.
Set surg = srg.Cells(sr)
Else
Set surg = Union(surg, srg.Cells(sr))
End If
End If
End If
End If
Next sr
' Copy all source rows in one go below ('.Offset(1)') the last cell.
If Not surg Is Nothing Then
surg.EntireRow.Copy dCell.Offset(1).EntireRow
End If
MsgBox "Data updated.", vbInformation
End Sub
uj5u.com熱心網友回復：
不，您不需要回圈。您需要范圍的查找功能 請參閱查找方法檔案 (Excel) 以及Excel VBA 查找完整指南
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/471473.html
上一篇：慢，嵌套的For回圈