如果 ((工作表 2，列 A) 或 (工作表 3，列 A)) 中的值不存在(工作表 1，列 A)，则在工作表 1 中创建新行

Question

我正试图编写一个宏，将在sheet1上的列a中查看，看看它是否缺少sheet2上的列a或sheet3上的列a的任何值。如果缺少，则将值添加到sheet1上A列的底部。相同的值可能存在于sheet2和sheet3上，但它只需要在sheet1上表示一次。

我正在处理下面的代码。

Sub newRow()
Dim rngSh1 As Range, rngSh2 As Range, rngSh3 As Range, mySelSh2 As Range, mySelSh3 As Range
Dim lastRowSh1 As Long, lastRowSh2 As Long, lastRowSh3 As Long
Dim wb As Worksheet
Dim cell As Range
Set wb = ThisWorkbook
With wb
lastRowSh1 = Worksheets("Sheet1").Range("A" & .Rows.Count).End(xlUp).Row
lastRowSh2 = Worksheets("Sheet2").Range("A" & .Rows.Count).End(xlUp).Row
lastRowSh3 = Worksheets("Sheet3").Range("A" & .Rows.Count).End(xlUp).Row
Set rngSh1 = Worksheets("Sheet1").Range("A1:A" & lastRowSh1)
Set rngSh2 = Worksheets("Sheet2").Range("A1:A" & lastRowSh2)
Set rngSh3 = Worksheets("Sheet3").Range("A1:A" & lastRowSh3)
End With
For Each cell In rngSh2.Cells
If IsError(Application.Match(cell.Value, rngSh1, 0)) Then
If mySelSh2 Is Nothing Then
Set mySelSh2 = cell
Else
Set mySelSh2 = Union(mySelSh2, cell)
End If
End If
Next cell
If Not mySelSh2 Is Nothing Then mySelSh2.Copy Destination:=Worksheets("Sheet1").Range("A" & lastRowSh1 + 1)
For Each cell In rngSh3.Cells
If IsError(Application.Match(cell.Value, rngSh1, 0)) Then
If mySelSh3 Is Nothing Then
Set mySelSh3 = cell
Else
Set mySelSh3 = Union(mySelSh3, cell)
End If
End If
Next cell
If Not mySelSh3 Is Nothing Then mySelSh3.Copy Destination:=Worksheets("Sheet1").Range("A" & lastRowSh1 + 1)
End Sub

我已经做了我能想到的每一个调整，但每次我做的改变都得到了不同的错误。任何帮助都将非常感激。谢谢!

Answer 1

使用Scripting.Dictionary:

为自己节省一点时间

Option Explicit
Sub test()
Dim dict As New Scripting.dictionary, sheetNum As Long
For sheetNum = 2 To Sheets.Count
With Sheets(sheetNum)
Dim lastRow As Long:  lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Dim rowNum As Long
For rowNum = 1 To lastRow
Dim dictVal As Long:  dictVal = .Cells(rowNum, 1).Value
If Not dict.Exists(dictVal) Then dict.Add dictVal, 0
Next rowNum
End With
Next sheetNum
With Sheets(1)
Dim checkableRangeLastRow As Long:  checkableRangeLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Dim checkableRange As Range:  Set checkableRange = .Range(.Cells(1, 1), .Cells(checkableRangeLastRow, 1))
Dim dictKey As Variant
For Each dictKey In dict.Keys
If IsError(Application.Match(dictKey, checkableRange, 0)) = True Then
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(lastRow + 1, 1).Value = dictKey
End If
Next dictKey
End With
End Sub

将非母表中的所有值添加到dict中，然后循环该列表;如果在母表中没有找到，则将其添加到列表末尾。

值得注意的是，如果IsError()语句与checkableRange中评估的数据不同，Type的值用作dictVal可能会导致CC_5语句始终为True。