Sub Example()
Dim dictNames As Object, arrKeys
Dim curCell As Range, curName As String
Set dictNames = CreateObject("Scripting.Dictionary")
dictNames.CompareMode = 1
For Each curCell In Range("a1:a6")
curName = curCell.Value
If dictNames.Exists(curName) Then
dictNames.Item(curName) = dictNames.Item(curName) + 1
Else
dictNames.Add curName, 1
End If
Next curCell
arrKeys = dictNames.Keys
For i = 0 To dictNames.Count - 1
MsgBox arrKeys(i) & ": " & dictNames.Item(arrKeys(i))
Next
End Sub
VBA:поиск одинаковых данных в ячеках
Доброго времени суток, уважаемые форумчане!
Не могли бы вы подсказать, направить меня в нужном направлении.
Имеется таблица, с данным, в ячейках A1-An хранятся разные имена, некоторые из них повторяются. Подскажите пожалуйста, каким образом можно организовать подсчет каждого повторяющегося имени в таблице?
Тоесть сколько раз повторилось каждое имя.
Заранее спасибо за ответ.
Не могли бы вы подсказать, направить меня в нужном направлении.
Имеется таблица, с данным, в ячейках A1-An хранятся разные имена, некоторые из них повторяются. Подскажите пожалуйста, каким образом можно организовать подсчет каждого повторяющегося имени в таблице?
Тоесть сколько раз повторилось каждое имя.
Заранее спасибо за ответ.
=COUNTIF(A1:A6,"Artur")
Цитата: Ariman
Имеется таблица, с данным, в ячейках A1-An хранятся разные имена, некоторые из них повторяются. Подскажите пожалуйста, каким образом можно организовать подсчет каждого повторяющегося имени в таблице?
Тоесть сколько раз повторилось каждое имя.
Тоесть сколько раз повторилось каждое имя.
Если инструментом решения должен служить макрос, а не функции рабочего листа, то алгоритм может быть таким:
- заводим массив для регистрации уникальных вариантов имён и массив счётчиков для них;
- организуем цикл по заданному диапазону ячеек для перебора всех значений;
- для каждого значения выполняем проверку наличия его в массиве уникальных имён (опять же в цикле); если проверяемое имя уже встречается в массиве, то увеличиваем значение соответствующего счётчика, если - не встречается, то добавляем его в массив и создаём очередной счётчик;
- нужным образом организуем вывод результатов (в окно сообщений, в файл, на лист и т.п.).
Если задача не учебная, то рекомендую использовать возможности объекта Dictionary из состава WSH. Вот пример:
Код:
Цитата: Ariman
Доброго времени суток, уважаемые форумчане!
Не могли бы вы подсказать, направить меня в нужном направлении.
Имеется таблица, с данным, в ячейках A1-An хранятся разные имена, некоторые из них повторяются. Подскажите пожалуйста, каким образом можно организовать подсчет каждого повторяющегося имени в таблице?
Тоесть сколько раз повторилось каждое имя.
Заранее спасибо за ответ.
Не могли бы вы подсказать, направить меня в нужном направлении.
Имеется таблица, с данным, в ячейках A1-An хранятся разные имена, некоторые из них повторяются. Подскажите пожалуйста, каким образом можно организовать подсчет каждого повторяющегося имени в таблице?
Тоесть сколько раз повторилось каждое имя.
Заранее спасибо за ответ.
Прекрасным средством для этого (и для много другого) является Сводная таблица (Pivot Table). Объяснения нужны?
Pivot Table
Можно по подробней в общих чертах, если вас не затруднит?
По-поводу WSH, насколько я понимаю, это не ходит в состав Excel, все нужно реализовать в макросе.
Вопрос по-поводу алгоритма поиска имени. Вначале считваем первую ячейку, потом проверяем вторую, если не идентично, то пишем в массив второе имя, не пойму каким образом реализовать вот этот сам алгоритм сравнения всех данных.
Можно по подробней в общих чертах, если вас не затруднит?
По-поводу WSH, насколько я понимаю, это не ходит в состав Excel, все нужно реализовать в макросе.
Вопрос по-поводу алгоритма поиска имени. Вначале считваем первую ячейку, потом проверяем вторую, если не идентично, то пишем в массив второе имя, не пойму каким образом реализовать вот этот сам алгоритм сравнения всех данных.
Так тебе обязательно это делать макросом? Макрос-то здесь необязателен. Можно с ним, можно без него...
И ещё скажи, какая у тебя версия Экселя, я имею в виду год и язык, чтобы мне не дублировать объяснения.
И ещё скажи, какая у тебя версия Экселя, я имею в виду год и язык, чтобы мне не дублировать объяснения.
Нужно макросом... 2003 офис, англ.вер
Объясните плз как на коде будет выглядеть, а то я никак не могу понять этот алгоритм.
Объясните плз как на коде будет выглядеть, а то я никак не могу понять этот алгоритм.
Цитата: Ariman
Объясните плз как на коде будет выглядеть, а то я никак не могу понять этот алгоритм.
Вот один из вариантов:
Код:
Sub Example()
Dim curCell As Range
Dim arrNames() As String, arrNumNames() As Long
Dim resFind As Boolean
Dim curName As String
ReDim arrNames(1 To 1)
ReDim arrNumNames(1 To 1)
arrNames(1) = Range("a1").Value
arrNumNames(1) = 1
For Each curCell In Range("a2:a6")
curName = curCell.Value
i = LBound(arrNames)
Do
If StrComp(curName, arrNames(i), vbTextCompare) = 0 Then
arrNumNames(i) = arrNumNames(i) + 1
resFind = True
Else
i = i + 1
End If
Loop While resFind = False And i <= UBound(arrNames)
If resFind = False Then
ReDim Preserve arrNames(1 To i)
ReDim Preserve arrNumNames(1 To i)
arrNames(i) = curName
arrNumNames(i) = 1
Else
resFind = False
End If
Next curCell
For i = LBound(arrNames) To UBound(arrNames)
MsgBox arrNames(i) & ": " & arrNumNames(i)
Next i
End Sub
Dim curCell As Range
Dim arrNames() As String, arrNumNames() As Long
Dim resFind As Boolean
Dim curName As String
ReDim arrNames(1 To 1)
ReDim arrNumNames(1 To 1)
arrNames(1) = Range("a1").Value
arrNumNames(1) = 1
For Each curCell In Range("a2:a6")
curName = curCell.Value
i = LBound(arrNames)
Do
If StrComp(curName, arrNames(i), vbTextCompare) = 0 Then
arrNumNames(i) = arrNumNames(i) + 1
resFind = True
Else
i = i + 1
End If
Loop While resFind = False And i <= UBound(arrNames)
If resFind = False Then
ReDim Preserve arrNames(1 To i)
ReDim Preserve arrNumNames(1 To i)
arrNames(i) = curName
arrNumNames(i) = 1
Else
resFind = False
End If
Next curCell
For i = LBound(arrNames) To UBound(arrNames)
MsgBox arrNames(i) & ": " & arrNumNames(i)
Next i
End Sub
Спасибо громное,щас будем пробовать.