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)