макрос для группировки записей и запись в новые листы по группам

[MrGB]

Помогите, пожалуйста, с задачкой:

есть лист с информацией о клиентах: фамилия, код и номер счета.
У одного клиента могут быть много счетов.
Нужно сгруппировать клиентов по количеству счетов и записать информацию о них в листы, названия которых равны количеству счетов (т.е. на лист с названием "1" попадут все клиенты с одним номером счета, "2" - с двумя и так далее. Номера, которых нет пропускаем естественно)

[Hugo121]

Пробуйте.
Если листов нет, то они создаются.

[doober]

У меня к решению таких вопросов всегда один подход.

[EugeneS]

Предварительно необходимо подключить данну библиотеку: Сервис - Редактор Visual Basic - Tools - References - установите птичку напротив Microsoft ActiveX Data Objects 2.0 Library - OK. Запустите макрос "GroupOnSheets"

[Hugo121]

Внёс поправку - теперь уникальные определяются по коду. В первой версии определялись по фамилии.
Кстати, конкуренты тоже смотрят по фамилии - с меня что-ли списывали?

[MrGB]

Сообщение от Hugo121

Внёс поправку - теперь уникальные определяются по коду. В первой версии определялись по фамилии.
Кстати, конкуренты тоже смотрят по фамилии - с меня что-ли списывали?

спасибо за помощь! вечером скину вознаграждение

я немного переделал - сделал возможность выбора столбца для сортировки и диапазона для копирования.
Вот мои изменения в Вашей функции:

For Each k In oDict.keys
        ReDim tempArr(1 To UBound(a, 1), 1 To UBound(a, 2))
        x = 0
        For i = 1 To UBound(a)
            If a(i, p_col_sort) = k Then
                x = x + 1
                y = 0
                For z = p_col_b To p_col_e
                    y = y + 1
                    tempArr(x, y) = a(i, z)
                Next
            End If
        Next
        shname = CStr(oDict.Item(k))
        If Not Sh_Exist(shname) Then
            Sheets.Add.Name = shname
            Sheets(p_sheet_name).Range(v_col_b & "1:" & v_col_e & "1").Copy Sheets(shname).Range("A1")
        End If
        Sheets(shname).Range("A" & Sheets(shname).Range("a" & Rows.Count).End(xlUp).Row + 1).Resize(x, UBound(tempArr, 2)).Value = tempArr    
   Next

у меня около 6 тыс. записей - получается медленно - примерно 20 сек. Нельзя ли как-нибудь побыстрее?

[SAS888]

Нельзя ли как-нибудь побыстрее?

Можно попробовать не копировать диапазоны в цикле, а накапливать массивы, а затем, после окончания цикла, "раскидать полученные массивы по требуемым листам.
Должно быть быстрее.

[Hugo121]

Нда, с накоплением в массив сложнее... Если заранее известно максимальное количество счетов, то можно заготовить столько массивов и набирать в них, но сейчас в коде это количество не ограничено.
Может варианты на ADO побыстрее будут? Только вот как на номера счетов переделать - это к авторам.

[Hugo121]

Может переделать код таким образом - набирать номера в словарь или коллекцию, а как Item иметь массив строк по этому номеру, куда динамически добавлять записи.
Потом в конце как-то это всё обобщить...
Я так ещё не делал, так что ничего не обещаю.

[doober]

Сообщение от Hugo121

Может варианты на ADO побыстрее будут? Только вот как на номера счетов переделать - это к авторам.

Роли не играет по фамилиям или счетам.ТС я так понял не заинтересовали эти варианты,не привел время выполнения макроса.
ускорить немного можно если нужно.

Кстати, конкуренты тоже смотрят по фамилии - с меня что-ли списывали?

.
Так удобнее выводить список фамилий по алфавиту