Собрать с разных листов из плоских файлов в один отчет

@dianavetr · Регистрация: 20.11.2017

Студворк — интернет-сервис помощи студентам

Ребята привет,нужно консолидировать реестры с разных листов в один сводный отчет в отдельном листе.

Реестры в виде плоских файлов: тоесть каждая операция разбивается на число строк равное числу позиции товаров/услуг.

Пример - одна реализация состоящая из 3х товаров и 1ой услуге, бъется на 4 строки. Сама прописала только формулами, в основном СУММЕСЛИМН

Просьба помочь с кодом,если будет у вас время.Очень выручите.

Пример приложила

@dianavetr · 20.11.2017, 15:35 **[ТС]**

Забыла добавить, в каждом листе данные добавляются и может доходить до 10тыс строк

@nodirstein · 21.11.2017, 16:08

dianavetr, Вот проверьте-ка такое решение?

@Hugo121 · 21.11.2017, 17:00

nodirstein, я ещё вчера сделал, на семи словарях, на другом форуме...

@nodirstein · 22.11.2017, 12:44

dianavetr, Эта версия быстрее предыдущей работает....

@nodirstein · 22.11.2017, 12:45

Hugo121, Скинь сюда или ссылку дай? Хочу посмотреть. У меня один словарь и 4 массива.

@Hugo121 · 22.11.2017, 13:02

Тут ведь нельзя ссылки давать

Я там делал просто - во всех словарях ключём идёт номер, в некоторых ещё с словом и датой.
Выгрузку можно ускорить через массив, но поленился, и не хотел усложнять понимание кода.
Ну и ещё чуть с тримом можно подускорить, позже заметил.
Вот версия с того форума:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Option Explicit
 
Sub tt()
    Dim a, i&, t$, k
    Dim DicSklad As Object
    Dim ****lient As Object
    Dim DicData As Object
    Dim DicZak As Object
    Dim DicRealiz1 As Object
    Dim DicRealiz2 As Object
    Dim DicPostup As Object
 
    Set DicSklad = CreateObject("Scripting.Dictionary"): DicSklad.comparemode = 1
    Set ****lient = CreateObject("Scripting.Dictionary"): ****lient.comparemode = 1
    Set DicData = CreateObject("Scripting.Dictionary"): DicData.comparemode = 1
    Set DicZak = CreateObject("Scripting.Dictionary"): DicZak.comparemode = 1
    Set DicRealiz1 = CreateObject("Scripting.Dictionary"): DicRealiz1.comparemode = 1
    Set DicRealiz2 = CreateObject("Scripting.Dictionary"): DicRealiz2.comparemode = 1
    Set DicPostup = CreateObject("Scripting.Dictionary"): DicPostup.comparemode = 1
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    a = Sheets("Реестр реализаций").[a1].CurrentRegion.Value
    For i = 2 To UBound(a)
        t = Trim(a(i, 11))
        DicSklad.Item(t) = Trim(a(i, 5))
        ****lient.Item(t) = Trim(a(i, 10))
        DicData.Item(t) = a(i, 12)
        t = Trim(a(i, 11)) & "|" & Trim(a(i, 4))
        DicRealiz1.Item(t) = DicRealiz1.Item(t) + a(i, 7)
        DicRealiz2.Item(t) = DicRealiz2.Item(t) + a(i, 8)
    Next
 
    a = Sheets("Реестр заказов покупателей").[a1].CurrentRegion.Value
    For i = 2 To UBound(a)
        t = Trim(a(i, 2))
        If DicSklad.Item(t) = "" Then DicSklad.Item(t) = Trim(a(i, 9))
        If ****lient.Item(t) = "" Then ****lient.Item(t) = Trim(a(i, 10))
        If DicData.Item(t) = "" Then DicData.Item(t) = a(i, 1)
 
        If Trim(DicData.Item(t)) <> Trim(a(i, 1)) Then MsgBox "Расхождение в датах на листе Реестр заказов покупателей по заказу " & t _
           & vbNewLine & DicData.Item(t) & "<>" & a(i, 1), vbCritical
 
        t = Trim(a(i, 2)) & "|" & Trim(a(i, 6))
        DicZak.Item(t) = DicZak.Item(t) + a(i, 8)
    Next
 
    a = Sheets("Реестр поступлений").[a1].CurrentRegion.Value
    For i = 2 To UBound(a)
 
        t = Trim(a(i, 9))
        If DicSklad.Item(t) = "" Then DicSklad.Item(t) = Trim(a(i, 8))
        If ****lient.Item(t) = "" Then ****lient.Item(t) = "Покупатель"
        If DicData.Item(t) = "" Then DicData.Item(t) = a(i, 10)
        
        If Trim(DicData.Item(t)) <> Trim(a(i, 10)) Then MsgBox "Расхождение в датах на листе Реестр поступлений по заказу " & t _
           & vbNewLine & DicData.Item(t) & "<>" & a(i, 10), vbCritical
 
        t = Trim(a(i, 9)) & "|" & Trim(a(i, 4)) & "|" & a(i, 10)
        DicPostup.Item(t) = DicPostup.Item(t) + a(i, 6)
    Next
 
    With Sheets("Сводная")
        i = 9    ' для сравнения с заказом, в рабочем варианте ставьте 3
        For Each k In DicSklad.keys
            i = i + 1
            .Cells(i, 2).Value = DicSklad(k)
            .Cells(i, 3).Value = ****lient(k)
            .Cells(i, 4).Value = k
            .Cells(i, 5).Value = DicData(k)
            .Cells(i, 6).Value = DicZak(k & "|Товар")
            .Cells(i, 7).Value = DicZak(k & "|Услуга")
            .Cells(i, 8).Formula = "=" & .Cells(i, 6).Address(0, 0) & "+" & .Cells(i, 7).Address(0, 0)
 
            .Cells(i, 9).Value = DicRealiz1(k & "|Товар")
            .Cells(i, 10).Value = DicRealiz1(k & "|Услуга")
            .Cells(i, 11).Formula = "=" & .Cells(i, 9).Address(0, 0) & "+" & .Cells(i, 10).Address(0, 0)
            .Cells(i, 12).Value = DicRealiz2(k & "|Товар")
            .Cells(i, 13).Value = DicRealiz2(k & "|Услуга")
            .Cells(i, 14).Formula = "=" & .Cells(i, 12).Address(0, 0) & "+" & .Cells(i, 13).Address(0, 0)
 
            .Cells(i, 15).Value = DicPostup(k & "|Товар|" & .Cells(i, 5))
            .Cells(i, 16).Value = DicPostup(k & "|Услуга|" & .Cells(i, 5))
            .Cells(i, 17).Formula = "=" & .Cells(i, 15).Address(0, 0) & "+" & .Cells(i, 16).Address(0, 0)
 
        Next
    End With
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
End Sub

Нашёл в коде пару лишних "операций" - там в трёх местах есть такая последовательность:
Код:

t = Trim(a(i, 11))
...
t = Trim(a(i, 11)) & "|" & Trim(a(i, 4))

Нижнюю строку можно записать так:
Код:

t = t & "|" & Trim(a(i, 4))

будет на один Trim() меньше, ускоритесь может на секунду.

Новые блоги и статьи Все статьи Все блоги /
Установка Qt Creator для C и C++: ставим среду, CMake и MinGW без фреймворка Qt 8Observer8 05.04.2026 Среду разработки Qt Creator можно установить без фреймворка Qt. Есть отдельный репозиторий для этой среды: https:/ / github. com/ qt-creator/ qt-creator, где можно скачать установщик, на вкладке Releases:. . .	AkelPad-скрипты, структуры, и немного лирики.. testuser2 05.04.2026 Такая программа, как AkelPad существует уже давно, и также давно существуют скрипты под нее. Тем не менее, прога живет, периодически что-то не спеша дополняется, улучшается. Что меня в первую очередь. . .	Отображение реквизитов в документе по условию и контроль их заполнения Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеСпецтехники", разработанного в конфигурации КА2. Данный документ берёт данные из другого нетипового документа. . .	Фото всей Земли с борта корабля Orion миссии Artemis II kumehtar 04.04.2026 Это первое подобное фото сделанное человеком за 50 лет. Снимок называют новым вариантом легендарной фотографии «The Blue Marble» 1972 года, сделанной с борта корабля «Аполлон-17». Новое фото. . .
Вывод диалогового окна перед закрытием, если документ не проведён Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать программный контроль на предмет проведения документа. . .	Программный контроль заполнения реквизитов табличной части документа Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: 1. Реализовать контроль заполнения реквизита. . .	wmic не является внутренней или внешней командой Maks 02.04.2026 Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/	Программная установка даты и запрет ее изменения Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .

@dianavetr 0 / 0 / 0 Регистрация: 20.11.2017 Сообщений: 2
	20.11.2017, 15:35 [ТС]
	Забыла добавить, в каждом листе данные добавляются и может доходить до 10тыс строк 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	21.11.2017, 17:00
	nodirstein, я ещё вчера сделал, на семи словарях, на другом форуме... 0

@nodirstein 32 / 32 / 8 Регистрация: 12.04.2015 Сообщений: 79
	22.11.2017, 12:45
	Hugo121, Скинь сюда или ссылку дай? Хочу посмотреть. У меня один словарь и 4 массива. 0