Страницы: 1
RSS
Вывод уникальных пар ячеек на другой лист, массив внутри словаря?
 
Здравствуйте! На Листе1 размещена таблица с данными. Мне нужно с этого листа переместить столбцы D и E на Лист2 в столбцы B и C, чтобы при этом остались только уникальные пары построчно: в примере повторяющиеся пары выделены одним цветом для наглядности. На Листе2 изобразил, что хочется получить в результате.

Попытка достигнуть желаемого путем занесения данные в словарь, где keys являются склеенные значения ячеек столбцов D и E, а items - массив  из значения левой ячейки и значения правой увенчалась успехом частично: внести эти данные в массив внутри словаря получается, а вот вывести на лист разом - нет.
 
Код
Sub ArrayFromDict_toWs()
Dim d As Object, j, rng, c As Range, i&

    Set rng = Sheets("Лист1").Range("D1:D" & Cells(1, 5).End(4).Row)
    Set d = CreateObject("Scripting.Dictionary")
            
        For Each c In rng
            j = c.Value & c.Offset(, 1).Value
            d.Item(j) = Array(c.Value, c.Offset(, 1).Value)
        Next c
    cr = 1
    For Each vk In d.keys
        Sheets("Лист2").Cells(cr, 2).Resize(, 2) = Array(d(vk)(0), d(vk)(1))
        cr = cr + 1
    Next
End Sub
 
skais675, супер, спасибо огромное!
Изменено: zav - 08.07.2022 12:58:59
 
Очень странное задание))) делается за 10 секунд: копируете столбцы D и E на Лист2. Выделяете их, затем выбираете: Данные - Удалить дубликаты. Готово!
Страницы: 1
Наверх