将行存储在vba词典A1：D8中，如果匹配，则粘贴A列中的单元格值是否匹配K列中的唯一键，然后粘贴

Question

Dim Cell    As Range
    Dim Data    As Variant
    Dim Dict    As Object
    Dim Item    As Variant
    Dim Key     As Variant
    Dim Rng     As Range
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet

        Set Wks = ThisWorkbook.activesheet

        Set RngBeg = Wks.Range("A1:D8")
        Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)

        If RngEnd.Row < RngBeg.Row Then Exit Sub

        Set Rng = Wks.Range(RngBeg, RngEnd)

        Set Dict = CreateObject("Scripting.Dictionary")
            Dict.CompareMode = vbTextCompare

            For Each Cell In Rng.Columns(1).Cells
                Key = Trim(Cell)
                Item = Cell.Resize(1, Rng.Columns.Count).Value

    With activesheet
        For Each Cell In .Range("k2", .Range("k" & Rows.Count).End(xlUp))
            If Dict.exists(Cl.Value) Then Cell.Offset(, 1).Value = Dic(Cell.Value)
        Next Cell
    End With

在K列中，我的值是：98,34,78,11在A栏中，我有：98,98,98,11,34,78,78

字典将每一行存储在col A：D中

例如：

98,east,phone,address
98,west,mobile,na

，然后检查A1：98中的第一个单元格是否与K列匹配，是否将行A1：D1粘贴到与98相对应的K列中的行旁边，如果有多个匹配项（即A列中的3 98），则插入一行。

这里发生了问题，应该将值粘贴到唯一键旁边，即K列中的98，但不这样做：

    With activesheet
        For Each Cell In .Range("k2", .Range("k" & Rows.Count).End(xlUp))
            If Dict.exists(Cell.Value) Then Cell.Offset(, 1).Value = Dic(Cell.Value)
        Next Cell
    End With

有人可以建议出什么问题吗？

我已经编辑了从此处引用的代码：

• http://www.vbaexpress.com/forum/showthread.php?60005-Store-rows-in-dictionary-or-collection

• https://www.mrexcel.com/board/threads/vba-to-find-match-of-cell-value-and-copy-adjacent-cell-when-match-found.1112978/

Answer 1

Dictionary Keys必须是唯一的，因此，如果从A列构建它，则在向下扫描时，所有先前的值都将被替换。假设第K列的值是唯一的，则使用该列以cell作为键并以行号作为值来构建字典。然后，通过扫描A列，词典将给出要复制到Col A：D的目标行。添加行时，它变得更加复杂，因为必须刷新字典。