Добрый день, помогите дописать макрос, сейчас в ячейках с F2 пи выполнении макроса "список" формируется уникальный список из двух позиций, но не могу в третий столбец вывести сколько раз данные комбинации встречались в исходном списке С2:D21. Сразу оговорюсь, что использование формулы countif не подойдет, надо считать количество по уникальному ключу в массиве и выводить в столбец H. Спасибо
Добрый день, помогите дописать макрос, сейчас в ячейках с F2 пи выполнении макроса "список" формируется уникальный список из двух позиций, но не могу в третий столбец вывести сколько раз данные комбинации встречались в исходном списке С2:D21. Сразу оговорюсь, что использование формулы countif не подойдет, надо считать количество по уникальному ключу в массиве и выводить в столбец H. Спасибоmss
На основе Вашего макроса, особо там не переделывая ничего, хоть и хотелось [vba]
Код
Sub список() Dim arr arr = Range("C2:D21") ReDim b(1 To UBound(arr), 1 To 2) With CreateObject("scripting.dictionary") .CompareMode = 1 For i = 1 To UBound(arr) t = arr(i, 1) & "|" & arr(i, 2) If Len(t) > 1 Then If Not .exists(t) Then .Item(t) = 1 ii = ii + 1 b(ii, 1) = arr(i, 1) b(ii, 2) = arr(i, 2) Else .Item(t) = .Item(t) + 1 End If End If Next If ii > 0 Then [f2].Resize(ii, 2) = b [f2].Offset(, 2).Resize(ii) = Application.Transpose(.Items) End With End Sub
[/vba]
*И посмотрите свою предыдущую тему, там еще ответ есть
На основе Вашего макроса, особо там не переделывая ничего, хоть и хотелось [vba]
Код
Sub список() Dim arr arr = Range("C2:D21") ReDim b(1 To UBound(arr), 1 To 2) With CreateObject("scripting.dictionary") .CompareMode = 1 For i = 1 To UBound(arr) t = arr(i, 1) & "|" & arr(i, 2) If Len(t) > 1 Then If Not .exists(t) Then .Item(t) = 1 ii = ii + 1 b(ii, 1) = arr(i, 1) b(ii, 2) = arr(i, 2) Else .Item(t) = .Item(t) + 1 End If End If Next If ii > 0 Then [f2].Resize(ii, 2) = b [f2].Offset(, 2).Resize(ii) = Application.Transpose(.Items) End With End Sub
[/vba]
*И посмотрите свою предыдущую тему, там еще ответ есть_Boroda_