сохранить строки в словаре 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

В столбце KI есть значения: 98,34,78,11, а в столбце AI - 98,98,98,11,34,78,78

Словарь сохраняет каждую строку в столбец A: D

, например:

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

, а затем проверяет, совпадает ли первая ячейка в A1: 98 со столбцом K и вставляет ли строку A1: D1 рядом со строкой в в столбце K, соответствующем 98, и вставьте строку, если в столбце A есть несколько совпадений, т. е. 3 98 с.

Проблема возникает здесь, где предполагается вставить значения рядом с уникальными ключами ie 98 в столбце K но не делает этого:

    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

Ключи словаря должны быть уникальными, поэтому, если вы строите его из столбца A, все предыдущие значения будут заменены при сканировании. Предполагая, что значения столбца K уникальны, используйте этот столбец для построения словаря, используя ячейку в качестве ключа и номер строки в качестве значения. Затем, сканируя столбец A, словарь даст целевую строку для Col A: D, на которую нужно скопировать. Это становится более сложным при добавлении строк, потому что словарь должен быть обновлен.