как сгруппировать строки в Excel?

[biv]

Прошу, подскажите что-нибудь.. или скажите, что ничего нельзя сделать

[IgorGO]

можно...
добавил два листа Отчет1 и Отчет2.
Отчет1 работает по такому алгоритму:
в колонке 3 предварительно записываются 17-значные коды, начиная с строки 2. По каждому коду собирается сумма значений из 13 колонки.
Отчет2:
перебирает все возможные 17-значные коды, которые есть на листах Документ (1) ... Документ (12).
В качестве исходных данных рассматриваются только листы, имя которых начяинается со слова "Документ"
Собраные суммы записываются в 9 колонку.

[KL (XL)]

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

можно...
добавил два листа Отчет1 и Отчет2.
Отчет1 работает по такому алгоритму:
в колонке 3 предварительно записываются 17-значные коды, начиная с строки 2. По каждому коду собирается сумма значений из 13 колонки.
Отчет2:
перебирает все возможные 17-значные коды, которые есть на листах Документ (1) ... Документ (12).
В качестве исходных данных рассматриваются только листы, имя которых начяинается со слова "Документ"
Собраные суммы записываются в 9 колонку.

А это нормально, что в результирующем списке коды дублируются?

[KL (XL)]

И еще вопрос к автору:
А чем не устраивает функционал Сводных таблиц с несколькими диапазонами консолидации? См. пример.

[IgorGO]

Это абсолютно неприемлемо!!!
Спасибо за проявленую бдительность.
строку

rw = WorksheetFunction.Match(Right(Sheets(sh).Cells(r2, 1), 17), Range(Cells(1, 3), Cells(r2-1, 3)), 0)

надо заменить на

rw = WorksheetFunction.Match(Right(Sheets(sh).Cells(r2, 1), 17), Range(Cells(1, 3), Cells(r, 3)), 0)

все должно наладиться...

[KL (XL)]

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

...Спасибо за проявленую бдительность...

Не то чтобы я специально проверял правильность кода. Я как раз использовал его результат как эталон для проверки моего решения, когда обнаружил повторы :-)

[Hugo121]

Я сделал на массивах, перебор листов позаимствовал (зачем писать с нуля ) - работает быстро, среднее время 0,21875 сек.
Правда результат с пустыми значениями, и не сортированный, это можно в коде поправить, но пока надо руками удалить строки с нулями и отсортировать - тогда можно сравнивать. В основном данные совпадают, но есть и расхождения, например
10601030100000110 = 179944,66 - в отчёте 541565.58
Можно ещё прикрутить и сравнение - например покрасить красным несовпадающие значения . Но это уже потом, если код понравится.
И будете сравнивать Вашу "ненавистную справка" за пару секунд - как бы кого не уволили за ненадобностью...

Sub hugo()
'tm = Timer
'Сперва вручную добавить лист для вывода данных, рассчитано на 13-й лист
Dim a(), b(), flag As Boolean, iLastrow As Long, i As Long, ii As Long, iiLastrow As Long
Dim x As Long
ReDim b(2, x)

For Each sh In Sheets
If Mid(sh.Name, 1, 8) <> "Документ" Then Exit For
With Sheets(sh.Name)

iLastrow = .Cells(9, 1).End(xlDown).Row - 1
a = Range(.Cells(9, 1), .Cells(iLastrow, 13)).Value
iiLastrow = iLastrow - 8
For i = 1 To iiLastrow
flag = True
For ii = 0 To x
If Mid(a(i, 1), 4, 10) & "0000" & Right(a(i, 1), 3) = b(0, ii) Then
b(2, ii) = b(2, ii) + a(i, 13)
flag = False
End If
Next
If flag Then
b(0, x) = Mid(a(i, 1), 4, 10) & "0000" & Right(a(i, 1), 3)
b(2, x) = a(i, 13)
x = x + 1
ReDim Preserve b(2, x)
End If
Next

End With
Next

Sheets(13).Columns("A:A").NumberFormat = "@"
Range(Sheets(13).Cells(1, 1), Sheets(13).Cells(x, 3)).Value = WorksheetFunction.Transpose(b)
'Debug.Print Timer - tm
End Sub

[alex77755]

Не совсем понятно в отчете..
Но как я понял - так и сделал программу
Результаты воводит на листь "Отчёт"

[Hugo121]

alex77755, в начале на нули три знака заменить надо.
Долго перебор работает - мой код на рабочей машине в среднем за 0.15625 отрабатывает (вроде меньше технически не показывает).

P.S.Вот такой вариант - передумал красить, это нефункционально. Ставлю пометки, по которым легко отсортировать.

Sub hugo2()
'tm = Timer
'Сперва вручную добавить лист для вывода данных, рассчитано на 13-й лист
Dim a(), b(), flag As Boolean, iLastrow As Long, i As Long, ii As Long, iiLastrow As Long
Dim x As Long
ReDim b(3, x)

For Each sh In Sheets
If Mid(sh.Name, 1, 8) <> "Документ" Then Exit For
With Sheets(sh.Name)

iLastrow = .Cells(9, 1).End(xlDown).Row - 1
a = Range(.Cells(9, 1), .Cells(iLastrow, 13)).Value
iiLastrow = iLastrow - 8
For i = 1 To iiLastrow
flag = True
For ii = 0 To x
If Mid(a(i, 1), 4, 10) & "0000" & Right(a(i, 1), 3) = b(0, ii) Then
b(2, ii) = b(2, ii) + a(i, 13)
flag = False
End If
Next
If flag Then
b(0, x) = Mid(a(i, 1), 4, 10) & "0000" & Right(a(i, 1), 3)
b(2, x) = a(i, 13)
x = x + 1
ReDim Preserve b(3, x)
End If
Next

End With
Next

'# Диалог открытия файла
Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists("C:\temp\biv\отчет.txt") Then
   Set objTextFile = objFSO.OpenTextFile("C:\temp\biv\отчет.txt", 1)
Else
   '# Диалог открытия файла
   Set objDialog = CreateObject("UserAccounts.CommonDialog")
   objDialog.Filter = "TXT Files|*.txt|All Files|*.*"
   objDialog.FilterIndex = 1
   objDialog.InitialDir = "C:\temp\biv\"
   intResult = objDialog.ShowOpen
   If intResult = 0 Then Wscript.Quit
   Const ForReading = 1
   Set objTextFile = objFSO.OpenTextFile(objDialog.Filename, ForReading)
End If

sep_ = Mid$(1 / 2, 2, 1)

Do Until objTextFile.AtEndOfStream 'пока не кончился файл
  strNextLine = objTextFile.Readline 'читаем посторочно
temnm = Mid(strNextLine, 9, 17)
tempsm = Trim(Mid(strNextLine, 78, 14))
If tempsm <> "" Then tempsm = CDbl(Replace(tempsm, ".", sep_))
For i = 0 To x
If b(0, i) = temnm Then
    If Trim(b(2, i)) <> "" Then
        If CDbl(Trim(b(2, i))) = tempsm Then
        b(3, i) = "совпадает"
        Else
        b(3, i) = "не совпадает"
        End If
    End If
End If
Next
Loop


Sheets(13).Columns("A:A").NumberFormat = "@"
Range(Sheets(13).Cells(1, 1), Sheets(13).Cells(x, 4)).Value = WorksheetFunction.Transpose(b)
'Debug.Print Timer - tm
End Sub

В результате не совпадают:
10601030100000110 179944.66 не совпадает
11201000010000120 578269.37 не совпадает
10503000010000110 13234.4 не совпадает
Есть ещё ненайденное 20805000100000180 46055.01

Добавил файл - текстовик используйте свой, будет предложено открыть.
Можно использовать в работе, но вообще-то надо немного изменённый код переложить в третий файл, из которого кодом открывать оба сравниваемых файла, и куда выводить данные сравнения. Так работать будет проще: получили файлы с данными - открыли файл с кодом - запустили макрос - выбрали, что сравнивать - готово.

[IgorGO]

biv, а Вы переживали...
то все молчали по очереди, то набросали разных вариантов.
Теперь, как говорится, задачи найти 10 различий, точнее - задача найти хоть какие-то сходства в результатах. Вы лицо заинтересованное, Вам и разбираться...А отчет небось пришлось вручную колбасить?

Hugo121, вот эта строчка

If Mid(sh.Name, 1, 8) <> "Документ" Then Exit For

неудачный вариант. Как только встретиться лист с именем не "Документ" цикл будет прерван и некоторые листы могут быть не обработаны.
лучше так написать:

If Mid(sh.Name, 1, 8) = "Документ" Then

и закрыть это ЭндИфом в правильном месте. Тогда цикл пройдется наверняка по всем листам.

Выложу исправленный вариант.