Excel VBA - 将列表中的值 append 到每日变化的数据上

Question

要解决的问题:
我的工作簿中的 Sheet1 每天都会刷新。 Sheet1 中的 B 列用帐户名称填充了几行(并且帐户名称可以有多行)。
我希望我的工作簿中的 Sheet2 A 列从 Sheet1 中的 B 列填充一个不同的不同帐户列表，其中 CATCH 是，我希望它不断 append ，因为 Sheet1 将每天填充一个新的帐户列表。换句话说，如果今天有 5 个帐户，明天有 2 个帐户，我希望工作表 2 A 列显示所有 7 个帐户。
我从其他帖子中收集了一些我认为会这样做的代码，但它没有在 Sheet2 中填充任何内容。请参阅下面的附件图像和代码:
data format
代码:

Sub TestMacro()


Dim Cell        As Range
Dim Key         As String
Dim Dict        As Object
Dim LookupWks   As Worksheet
Dim MstrWks     As Worksheet
Dim NextCell    As Range
Dim r           As Long

    Set MstrWks = ThisWorkbook.Worksheets("Sheet1")
    Set LookupWks = ThisWorkbook.Worksheets("Sheet2")
    
    Set Dict = CreateObject("Scripting.Dictionary")
        Dict.CompareMode = vbTextCompare
        
        For r = 2 To MstrWks.Cells(Rows.Count, "A").End(xlUp).Row
            Key = MstrWks.Cells(r, "A")
            If Trim(Key) <> "" Then
                If Not Dict.Exists(Key) Then
                    Dict.Add Key, r
                End If
            End If
        Next r
        
        Set NextCell = LookupWks.Cells(2, "A").End(xlUp).Offset(1, 0)
        
        For r = 2 To LookupWks.Cells(Rows.Count, "A").End(xlUp).Row
            Key = LookupWks.Cells(r, "A")
            If Trim(Key) <> "" Then
                If Not Dict.Exists(Key) Then
                    NextCell.Value = Key
                    Set NextCell = NextCell.Offset(1, 0)
                End If
            End If
        Next r
        

结束子
我已经对这个主题进行了相当多的研究，并将我看到的其他帖子和调整中的一些代码拼凑在一起，但它没有填充任何内容。

Answer 1

问题是您的代码只查看工作表 2 中填充的单元格，因此它在到达该工作表上不存在的键之前就停止了。
如果我们迭代字典而不是单元格并使用 find 它将使用缺少的键填充您的工作表 2:

Dim Cell        As Range
Dim key         As Variant ' I changed this to variant to use it as an iterator later on
Dim Dict        As Object
Dim LookupWks   As Worksheet
Dim MstrWks     As Worksheet
Dim NextCell    As Range
Dim r           As Long

    Set MstrWks = ThisWorkbook.Worksheets("Sheet1")
    Set LookupWks = ThisWorkbook.Worksheets("Sheet2")
    
    Set Dict = CreateObject("Scripting.Dictionary")
    Dict.CompareMode = vbTextCompare
    
' Don't forget to add a sheet reference to Rows.Count, it may give the wrong value
    For r = 2 To MstrWks.Cells(MstrWks.Rows.Count, "A").End(xlUp).Row
        key = MstrWks.Cells(r, "A")
        If Trim(key) <> "" Then
            If Not Dict.Exists(key) Then
                Dict.Add key, r
            End If
        End If
    Next r
    Dim findrng As Range
    With LookupWks
        r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        For Each key In Dict
            Set findrng = .Range("A:A").Find(key, .Cells(2, 1), xlValues, xlWhole, xlByRows, xlNext)
            If findrng Is Nothing Then
                .Cells(r, 1).Value = key
                r = r + 1
            End If
        Next key
    End With