Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Ветеран


Contributor


Сообщения: 2708
Благодарности: 1684

Профиль | Отправить PM | Цитировать


Изображения
Тип файла: png я210118.png
(46.5 Kb, 4 просмотров)
Вложения
Тип файла: txt я210118.vbs.txt
(3.0 Kb, 3 просмотров)

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) и картинку с результатом прикрепляю.

-------
Даже самая сложная проблема обязательно имеет простое, лёгкое для понимания, неправильное решение. Каждое решение плодит новые проблемы.


Последний раз редактировалось megaloman, 18-01-2021 в 18:51.


Отправлено: 18:42, 18-01-2021 | #19