Подсчитать количество повторяющихся значений в столбце
Zaka
Гость
05.05.2011 15:44:32
Здравствуйте!
Помогите, пож-та, с таблицей.
Есть таблица с названиями организаций. Список большой. Нужно подсчитать в отдельной таблице ( или на отдельный лист) Сколько раз одно наименование указывалось в таблице.
В конечном виде нужно примерно так: Ромашки 4 Трактор 2 Адмирал 1 Господа 2 и т.д.
Не видно Вашей укороченной... Попробуйте теперь протянуть формулу на одну ячейку вниз. Для большего количества - создайте список уникальных значений из столбца А. И справку не игнорируйте.
использую. Только т.к. он заточен суммировать суммы, то сперва в свободном столбце нужно всем протянуть единицы, а потом эти единицы просуммировать. Если задача регулярная - можно тот код чуть изменить, что не суммировал суммы по столбцу сумм, а считал повторы по столбцу значений. Пока так - запустили тот файл, в своём протянули единицы, выделили диапазон, серез Alt+F8 запустили макрос из того файла/
Пользователь
Сообщений: Регистрация: 21.12.2012
05.05.2011 18:59:10
Макрос выбирает уникальные записи из столбца А и переносит в столбец G, затем сортирует уникальный список и подсчитывает количество каждого уникального вхождения
Скомпоновал немного из кода Kuzmich'a, остальное из кода
Работает быстрее на 30%, без сортировки быстрее в 2 раза.
Sub UniqCount() Dim tm: tm = Timer Dim a(), oDict As Object, i As Long, temp As String Dim iLastRow As Long, iLastRow2 As Long, Rng2 As Range
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'посл.строка в диапазоне названий Range(Cells(2, 7), Cells(iLastRow, 7)).Clear 'очистка диапазона для уникальных
'определение диапазона названий a = Range(Cells(2, 1), Cells(iLastRow, 1)).Value
Set oDict = CreateObject("Scripting.Dictionary") oDict.CompareMode = 1 For i = 1 To UBound(a) ' If Len(a(i, 1)) Then If Not IsEmpty(a(i, 1)) Then temp = Trim(a(i, 1)) If Not oDict.Exists(temp) Then oDict.Add temp, 1 Else oDict.Item(temp) = oDict.Item(temp) + 1 End If End If 'End If Next
