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

[MrGB]

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

Если можете.киньте файл на мыло strojservis собака nxt.ru
посмотрю.в чем проблема

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

[MrGB]

Hugo121

как в Вашем макросе сохранить формат столбцов при копировании?
При копировании 20ти-значного числа, записанного строкой, оно становится числом и теряются цифры(

Я Вам в личку писал сообщения)

[Hugo121]

Сохранить сложно. Но ведь можно задать при создании листа:

        If Not Sh_Exist(shname) Then
            Sheets.Add.Name = shname
            Sheets(shname).Columns("C:C").NumberFormat = "@"
            Sheets("Лист1").Range("A1:C1").Copy Sheets(shname).Range("A1")
        End If

Проверил - нули остаются, если они были в исходных номерах.
Т.е. если изначально номер как текст, с ведущими нулями, то он такой и в массиве. А именно после выгрузки на лист, если формат на листе общий, то Эксель эти нули откидывает. И кстати может и конец испортить, если знаков много
Личку заметил только сейчас.
Про накопление в массиве - сложно, не получается. Потому что изначально количество массивов неизвестно, а создать их динамически кодом не получается.
Может кто другой подскажет? Как создать массивы например именно для 10-го листа и например для 5-го, чтобы туда складывать нужные записи?
Если Вы точно знаете максимальное количество счетов, то можно заранее сделать например 10 массивов размером с исходный, туда сложить данные, потом сразу выгрузить. Но если вдруг появится клиент с большим числом счетов?
Как кстати коды на ADO работают - может там проще это решить?

[nilem]

Просто из спортивного интереса

[Hugo121]

Интересно
Дома на 2003 заценю - тут на 2000 не проходит
m = WorksheetFunction.Max(WorksheetFunc tion.Index(x, 0, 4))
Но если не секрет - кто победил?

Кстати - Function Sh_Exist(sName As String) это не моё, это уже народное наверно

[doober]

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

Просто из спортивного интереса

нормально отработал.

То Hugo121 главное не победа .главное выполнить пожелания(заказ)клиента

[Hugo121]

Да в общем за то и боремся - лучше, быстрее, выше

[Hugo121]

Проверил - хорошо! В 5 раз быстрее моего. Что-то мне в голову такой простой ход не пришёл - каждого пометить.
А вместо WorksheetFunction.Max для 2000 можно просто в процессе запоминать максимальное в переменную. Может будет чуть помедленнее, но ненамного.
Только мелочи подправить - опять заменить привязку к фамилии на привязку к номеру, ну и формат нужных колонок текстовый добавить.

P.S. Заменил WorksheetFunction.Max для 2000 на

    For i = 1 To UBound(x, 1)
        If Not .Exists(x(i, 1)) Then
            .Add Key:=x(i, 1), Item:=1
        Else
            .Item(x(i, 1)) = .Item(x(i, 1)) + 1
            mm = .Item(x(i, 1)):  If mm > m Then m = mm
        End If
    Next i

Интересный эффект - в 2003 стало не медленнее, может даже чуть быстрее - отрабатывает около 1.14 сек., зато на 2000 за 0,32-0,39 сек.!