如果（（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

您將 not-master-sheet 中的所有值添加到dict中，然后遍歷該列表； 如果在您的主表中找不到它，那么您將 then 添加到列表的末尾。

值得注意的是，如果用作dictVal的值Type與 checkableRange 中評估的數據Type不同，則可能會導致checkableRange IsError()語句始終為True 。