如果（（Sheet2，Column A）或（Sheet3，Column A））中的值不存在于（Sheet 1，Column A）中，则在 Sheet1 中创建新行

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 中，然后遍历该列表；如果在您的主表中找不到它，那么您将 then 添加到列表的末尾。

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