Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

VBA:поиск одинаковых данных в ячеках

2.1K
12 января 2007 года
Ariman
102 / / 20.10.2005
Доброго времени суток, уважаемые форумчане!

Не могли бы вы подсказать, направить меня в нужном направлении.

Имеется таблица, с данным, в ячейках A1-An хранятся разные имена, некоторые из них повторяются. Подскажите пожалуйста, каким образом можно организовать подсчет каждого повторяющегося имени в таблице?
Тоесть сколько раз повторилось каждое имя.

Заранее спасибо за ответ.
13K
12 января 2007 года
Ser Artur
5 / / 06.10.2005
=COUNTIF(A1:A6,"Artur")
405
12 января 2007 года
Dmitrii
554 / / 16.12.2004
Цитата: Ariman
Имеется таблица, с данным, в ячейках A1-An хранятся разные имена, некоторые из них повторяются. Подскажите пожалуйста, каким образом можно организовать подсчет каждого повторяющегося имени в таблице?
Тоесть сколько раз повторилось каждое имя.


Если инструментом решения должен служить макрос, а не функции рабочего листа, то алгоритм может быть таким:
- заводим массив для регистрации уникальных вариантов имён и массив счётчиков для них;
- организуем цикл по заданному диапазону ячеек для перебора всех значений;
- для каждого значения выполняем проверку наличия его в массиве уникальных имён (опять же в цикле); если проверяемое имя уже встречается в массиве, то увеличиваем значение соответствующего счётчика, если - не встречается, то добавляем его в массив и создаём очередной счётчик;
- нужным образом организуем вывод результатов (в окно сообщений, в файл, на лист и т.п.).

Если задача не учебная, то рекомендую использовать возможности объекта Dictionary из состава WSH. Вот пример:

Код:
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
267
12 января 2007 года
Cutty Sark
1.2K / / 17.10.2002
Цитата: Ariman
Доброго времени суток, уважаемые форумчане!

Не могли бы вы подсказать, направить меня в нужном направлении.

Имеется таблица, с данным, в ячейках A1-An хранятся разные имена, некоторые из них повторяются. Подскажите пожалуйста, каким образом можно организовать подсчет каждого повторяющегося имени в таблице?
Тоесть сколько раз повторилось каждое имя.

Заранее спасибо за ответ.



Прекрасным средством для этого (и для много другого) является Сводная таблица (Pivot Table). Объяснения нужны?

2.1K
12 января 2007 года
Ariman
102 / / 20.10.2005
Pivot Table

Можно по подробней в общих чертах, если вас не затруднит?

По-поводу WSH, насколько я понимаю, это не ходит в состав Excel, все нужно реализовать в макросе.

Вопрос по-поводу алгоритма поиска имени. Вначале считваем первую ячейку, потом проверяем вторую, если не идентично, то пишем в массив второе имя, не пойму каким образом реализовать вот этот сам алгоритм сравнения всех данных.
267
13 января 2007 года
Cutty Sark
1.2K / / 17.10.2002
Так тебе обязательно это делать макросом? Макрос-то здесь необязателен. Можно с ним, можно без него...

И ещё скажи, какая у тебя версия Экселя, я имею в виду год и язык, чтобы мне не дублировать объяснения.
2.1K
13 января 2007 года
Ariman
102 / / 20.10.2005
Нужно макросом... 2003 офис, англ.вер

Объясните плз как на коде будет выглядеть, а то я никак не могу понять этот алгоритм.
405
16 января 2007 года
Dmitrii
554 / / 16.12.2004
Цитата: 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
2.1K
17 января 2007 года
Ariman
102 / / 20.10.2005
Спасибо громное,щас будем пробовать.
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог