Iska,
Elizavetta, Мне кажется, мы занимаемся не тем: откуда в Excel попадают данные? Вероятно, выгружаются из какой-то базы. И что такое отчет, какова его форма. Надо иметь какой-то отчетный бланк с красивыми заголовочками и т д. Не вижу, чем полученный нашими скриптами отчет (то ли на основе создания листов, то ли на основе группировки) лучше простого применения фильтра.
Надо на этапе выгрузки в Excel формировать отчет, на нужных листах Excel, а не изобретать костыли.
В качестве развлечения, наваял еще вариант не на основе создания листов, а на основе группировки данных.
Код:
InXls = "Z:\Box_In\реальные данные исходный лист.xlsx" 'имя исходного Excel-файла
' InXls = "Z:\Box_In\я210115.xlsx" 'имя исходного Excel-файла
Col1 = "A" 'Первая колонка данных
Col2 = "J" 'Последняя колонка данных
Row1 = 1 'Последняя строка шапки
Csort = "C" 'Колонка с сортируемыми данными
Csum1 = "B" 'Колонка с суммой 1
Csum2 = "D" 'Колонка с суммой 2
Csum3 = "E" 'Колонка с суммой 3
Csum4 = "F" 'Колонка с суммой 4
With WScript.Arguments
If .Count > 0 Then InXls = .Item(0)
End With
If Not CreateObject("Scripting.FileSystemObject").FileExists(InXls) Then
MsgBox "Файл:" + vbCrLf + InXls + vbCrLf + "не найден"
WScript.Quit 1
End If
TBegin = Timer
Set xls = CreateObject("Excel.Application")
With xls
.Visible = True 'True ' False
.Workbooks.Open InXls
InBook = .ActiveWorkbook.Name
InList = .Workbooks(InBook).ActiveSheet.Name
.Workbooks(InBook).Activate
.Columns(Col1 + ":" + Col2).EntireColumn.AutoFit
Head = .Range(Col1 + CStr(Row1) + ":" + Col2 + CStr(Row1))
End With
TLoad = Timer
Row2 = xls.Workbooks(InBook).Worksheets(InList).Range(Csort + CStr(Row1 + 1)).End(-4121).Row
With xls.Workbooks(InBook).Worksheets(InList).Sort
.SortFields.Clear
.SortFields.Add xls.Range(Csort + CStr(Row1 + 1) + ":" + Csort + CStr(Row2)), 0, 1, 0
.SetRange xls.Range(Col1 + CStr(Row1) + ":" + Col2 + CStr(Row2))
.Header = 1
.MatchCase = False
.Orientation = 1
.SortMethod = 1
.Apply
End With
TSort = Timer
i1 = Row1 + 1
NameList = xls.Range(Csort + CStr(i1))
With xls.Workbooks(InBook).Worksheets(InList)
i = i1
Do
If NameList <> xls.Range(Csort + CStr(i)) Then
.Rows(CStr(i)).Insert -4162, 0
.Range(Col1 + CStr(i)) = .Range(Csort + CStr(i - 1))
.Range(Csort + CStr(i)) = .Range(Csort + CStr(i - 1))
.Rows(CStr(i1) + ":" + CStr(i - 1)).Rows.Group
.Range(Csum1 + CStr(i)) = "=SUM(" + Csum1 + CStr(i1) + ":" + Csum1 + CStr(i - 1) + ")"
.Range(Csum2 + CStr(i)) = "=SUM(" + Csum2 + CStr(i1) + ":" + Csum2 + CStr(i - 1) + ")"
.Range(Csum3 + CStr(i)) = "=SUM(" + Csum3 + CStr(i1) + ":" + Csum3 + CStr(i - 1) + ")"
.Range(Csum4 + CStr(i)) = "=SUM(" + Csum4 + CStr(i1) + ":" + Csum4 + CStr(i - 1) + ")"
i = i + 1
i1 = i
NameList = .Range(Csort + CStr(i))
If Len(Trim(NameList)) = 0 Then Exit Do
End If
i = i + 1
Loop
.Outline.ShowLevels 1
.Range("A1").Select
End With
xls.Visible = True ' False
MsgBox "Сделано=" + CStr(Timer - TBegin) + " сек." + vbCrLf _
+ "Загрузка=" + CStr(TLoad - TBegin) + vbCrLf _
+ "Сортировка=" + CStr(TSort - TLoad) + vbCrLf _
+ "Группировка=" + CStr(Timer - TSort)
Скрипт (переименуйте txt в vbs) и картинку с результатом прикрепляю.