Автор Тема: Подсчёт одинаковых ячеек и их вывод  (Прочитано 151 раз)

Оффлайн Посетитель 08.06.2022

  • Посетитель форума
  • Сообщений: 1
Добрый день, столкнулся с такой задачей, необходимо подсчитать количество одинаковых данных в файле Excel, после чего нужно рядом вывести результат. Есть макрос на VBA, который это все делает, но есть проблема в диапазоне, как его можно туда вставить, чтобы данный макрос считал количество одинаковых значений по определённому столбцу, например по столбцу А?

Sub TEST()
    Dim Dic As Object, Ml As Range, i&, s$, key As Variant
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.comparemode = vbTextCompare
    i = Cells(Rows.Count, "A").End(xlUp).Row
    For Each Ml In Range("A2:A" & i)
        s = Ml & "|" & _
            Ml.Offset(, 1)
        If Not Dic.Exists(s) Then
           Dic.Add s, 1
        Else
            Dic(s) = CLng(Dic(s)) + 1
        End If
    Next Ml
    'Worksheets.Add
    i = 2
    [D1:F1].Value = Split("Сообщение|Описатель|Количество", "|")
    For Each key In Dic
        Range(Cells(i, "D"), Cells(i, "F")).Value = Split(key, "|")
        Cells(i, "F") = Dic(key)
        i = i + 1
    Next key
End Sub

Оффлайн Администратор

  • Administrator
  • Сообщений: 2029
Re: Подсчёт одинаковых ячеек и их вывод
« Ответ #1 : 08 Июнь 2022, 06:38 »
Сейчас ваш макрос считает количество в столбце A, это указано в этой строке:
For Each Ml In Range("A2:A" & i)

Макрос ищет последнюю строку в столбце A (скрытые строки не учитываются) и затем макрос просматривает диапазон от A2 до последней заполненной строки в столбце A.