Работа с файлами Excel

@lalike · Регистрация: 24.01.2011

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

какой процедурой выплняется сборка информации с эксель файлов?

Комментарий модератора

Именуйте темы осмысленно. Название темы должно максимально полно отражать ее содержание.

@DarkSacred · 26.01.2011, 12:36

Вот смотри, только я его не проверял, если что спрашивай

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
    'Выбираем файлы для загрузок
    nFile = Application.GetOpenFilename( _
                                            FileFilter:="xls-файл (*.xls),*.xls", _
                                            Title:="Выберите файлы для загрузки", _
                                            MultiSelect:=True)
                                            
    If IsEmpty(nFile) Or Not IsArray(nFile) Then Exit Sub       'выбран ли файл для загрузок
    qFile = UBound(nFile)                                       'запоминаем количество файлов
'---------------------------
    Set sh = ActiveSheet                                        'запоминает лист куда надо вносить информацию
    Row = 2                                                     'начинаем запись с 3 строчки
    For i = 1 To qFile
        Set book = Workbooks.Open(nFile(i))
        'заполняем общую информацию
        Row = Row + 1                   'переходим на след строчку в общей таблице
        sh.Cells(Row, 1) = Cells(8, 4)
        sh.Cells(Row, 2) = Cells(10, 4)
        sh.Cells(Row, 3) = Cells(11, 4)
        sh.Cells(Row, 4) = Cells(13, 4)
        'и т.д. заносите шапку файла
        
        'теперь переходим к таблице
        EndRow = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell)).Rows.count    'определяем последнию строчку
        For j = 32 To EndRow
            'смотрим заполненна ли первая ячейка в строчке j
            If Len(Cells(j, 1).Text) <> 0 Then
                'заполняем значения и зтаблицы
                sh.Cells(Row, 19) = Cells(j, 14)
                sh.Cells(Row, 20) = Cells(j, 13)
                ' и т.д.
                
            'если не заполненна первая ячейка смотрим заполненна ли 11 ячейка
            Else
                If Len(Cells(j, 11).Text) <> 0 Then
                    'заполняем итоговые данные
                    sh.Cells(Row, 22) = Cells(j, 11)
                    sh.Cells(Row, 26) = Cells(j, 17)
                    'после заполнения итоговых данных выходим из цикла For для J что бы дальше ни чего не смотрелось
                    Exit For
                End If
            End If
            Row = Row + 1               'переходим на след строчку в общей таблице
        Next j
        '--------------------------
        book.Close
    Next i

@lalike · 26.01.2011, 13:16 **[ТС]**

Добавлено через 22 секунды
у меня просто проходит цикл, но ничего не вставляет

Добавлено через 32 минуты
а как сделать так, чтобы

в файле источнике в столбе X строке Y брались данные,

потом в другом файле в столбе X1 сверялось с данными и если в строке Y1 оно сошлось, то бралось бы значение из столба Z1 строки Y1

и вставлялось бы в файл источник в столб Z строку Y?

@Busine2009 · 26.01.2011, 13:35

lalike,
вот код. Т.к. файл сделан в Excel 2003, а в коде есть команда, связанная с сохранением, то будет появляться диалоговое окно, связанное с разными форматами – жмите OK.
К коду в файле Word приложена пояснительная записка, которую нужно обязательно прочитать и если что-то не понятно, то спросить.

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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
Sub m_1()
Dim ЛистКонечный2 As Excel.Worksheet
Dim Флаг As Boolean
Dim oCell As Excel.Range
Dim ЛистИсточник As Excel.Worksheet
Dim ЛистКонечный As Excel.Worksheet
Dim i As Long
Dim j As Long
Dim LastRowКонечный As Long
Dim LastRowИсточник As Long
Dim СколькоОбъединять As Long
Dim Сумма
'Проверка, что добавлен лист в конечную книгу для записи в нём имён файлов, из которых данные уже получены.
    For Each ЛистКонечный2 In Workbooks("Конечный.xls").Worksheets
        If ЛистКонечный2.Name = "Имена файлов" Then
            Флаг = True
            Exit For
        End If
    Next ЛистКонечный2
    If Флаг = False Then
        MsgBox "Не добавлен лист в конечный файл для записи имён файлов, из которых данные уже взяты." & vbCr & _
            "Или лист имеет неправильное имя.", vbCritical
            Exit Sub
    End If
'Проверка, что с данного листа данные ещё не брались.
    With Workbooks("Конечный.xls").Worksheets("Имена файлов")
        For Each oCell In .Range("A" & .Cells.SpecialCells(xlCellTypeLastCell).Row)
            If oCell.Value = ActiveWorkbook.Name Then
                MsgBox "Из данного файла-источника данные уже брались", vbCritical
                Exit Sub
            End If
        Next oCell
    End With
Set ЛистИсточник = ActiveWorkbook.Worksheets(1)
Set ЛистКонечный = Workbooks("Конечный.xls").Worksheets(1)
LastRowКонечный = ЛистКонечный.Cells.SpecialCells(xlCellTypeLastCell).Row
If Selection.Address(ReferenceStyle:=xlR1C1) = "R1C1" Then
    ЛистКонечный.Cells(LastRowКонечный + 1, 4).Value = ЛистИсточник.Cells(8, 4).Value
    ЛистКонечный.Cells(LastRowКонечный + 1, 5).Value = ЛистИсточник.Cells(10, 4).Value
    ЛистКонечный.Cells(LastRowКонечный + 1, 6).Value = ЛистИсточник.Cells(11, 4).Value
    ЛистКонечный.Cells(LastRowКонечный + 1, 7).Value = ЛистИсточник.Cells(20, 4).Value
    ЛистКонечный.Cells(LastRowКонечный + 1, 8).Value = ЛистИсточник.Cells(10, 11).Value
    ЛистКонечный.Cells(LastRowКонечный + 1, 11).Value = ЛистИсточник.Cells(17, 11).Value
    ЛистКонечный.Cells(LastRowКонечный + 1, 12).Value = ЛистИсточник.Cells(17, 15).Value
    ЛистКонечный.Cells(LastRowКонечный + 1, 15).Value = 0
    ЛистКонечный.Cells(LastRowКонечный + 1, 17).Value = 0
    ЛистКонечный.Cells(LastRowКонечный + 1, 19).Value = 0
    ЛистКонечный.Cells(LastRowКонечный + 1, 20).Value = 0
    ЛистКонечный.Cells(LastRowКонечный + 1, 21).Value = 0
    ЛистКонечный.Cells(LastRowКонечный + 1, 22).Value = 0
    ЛистКонечный.Cells(LastRowКонечный + 1, 23).Value = 0
    ЛистКонечный.Cells(LastRowКонечный + 1, 24).Value = 0
    ЛистКонечный.Cells(LastRowКонечный + 1, 25).Value = 0
    ЛистКонечный.Cells(LastRowКонечный + 1, 26).Value = 0
    'Делаем запись на добавленном в конечную книгу листе, что данный файл-источник обработан.
    With Workbooks("Конечный.xls").Worksheets("Имена файлов")
        .Range("A" & .Cells.SpecialCells(xlCellTypeLastCell).Row + 1) = ActiveWorkbook.Name
    End With
    'Сохранение измений в конечной книге.
    Workbooks("Конечный.xls").Save
    'Просто сообщение, что работа макроса завершена.
    MsgBox "Данные из файла-источника взяты", vbInformation
    Exit Sub
ElseIf ActiveCell.Column <> 11 And ActiveCell.Column <> 17 Or _
    IsNumeric(ActiveCell) = False Or ActiveCell.Font.Bold = False Then
    MsgBox "Выделенными ячейками могут быть только R1C1, последняя ячейка столбца C11 или последняя ячейка столбца C17." & vbCr & _
        "Если это последняя ячейка столбца C11 или столбца C17, то проверьте форматирование этой ячейки: " & vbCr & _
        "в этой ячейке должно быть число и шрифт должен быть жирным.", vbCritical
    Exit Sub
End If
LastRowИсточник = ActiveCell.Row
'Заполним сначала столбец 17 в конечном файле, чтобы знать, сколько объединять ячеек в дальнейшем.
For i = 1 To LastRowИсточник - 31 Step 2
    If IsEmpty(ЛистИсточник.Cells(31 + i, 1).Value) = False Then
        j = j + 1
        ЛистКонечный.Cells(LastRowКонечный + j, 17).Value = ЛистИсточник.Cells(31 + i, 1).Value
    End If
Next i
j = 0
СколькоОбъединять = ЛистКонечный.Cells.SpecialCells(xlCellTypeLastCell).Row - LastRowКонечный
'Будем отдельно заносить данные в отношении ячеек конечного файла, имеющих и не имеющих объединение.
'Сначала поработаем с теми ячейками, которые нужно объединить.
'15 столбец
    For i = 1 To LastRowИсточник - 31 Step 2
        If IsEmpty(ЛистИсточник.Cells(31 + i, 12).Value) = False Then
            Сумма = Сумма + ЛистИсточник.Cells(31 + i, 12).Value
        End If
    Next i
    ЛистКонечный.Cells(LastRowКонечный + 1, 15).Value = Сумма
    With ЛистКонечный
        .Range(.Cells(LastRowКонечный + 1, 15), .Cells(LastRowКонечный + СколькоОбъединять, 15)).Merge
    End With
'22 столбец
    If IsEmpty(ЛистИсточник.Cells(LastRowИсточник, 17).Value) = False Then
        ЛистКонечный.Cells(LastRowКонечный + 1, 22).Value = ЛистИсточник.Cells(LastRowИсточник, 17).Value
    Else
        ЛистКонечный.Cells(LastRowКонечный + 1, 22).Value = 0
    End If
    With ЛистКонечный
        .Range(.Cells(LastRowКонечный + 1, 22), .Cells(LastRowКонечный + СколькоОбъединять, 22)).Merge
    End With
'26 столбец
    If IsEmpty(ЛистИсточник.Cells(LastRowИсточник, 11).Value) = False Then
        ЛистКонечный.Cells(LastRowКонечный + 1, 26).Value = ЛистИсточник.Cells(LastRowИсточник, 11).Value
    Else
        ЛистКонечный.Cells(LastRowКонечный + 1, 26).Value = 0
    End If
    With ЛистКонечный
        .Range(.Cells(LastRowКонечный + 1, 26), .Cells(LastRowКонечный + СколькоОбъединять, 26)).Merge
    End With
'Теперь с необъединёнными ячейками поработаем.
For i = 1 To LastRowИсточник - 32 Step 2
    j = j + 1
    If IsEmpty(ЛистИсточник.Cells(31 + i, 14).Value) = False Then
        ЛистКонечный.Cells(LastRowКонечный + j, 19).Value = ЛистИсточник.Cells(31 + i, 14).Value
    Else
        ЛистКонечный.Cells(LastRowКонечный + j, 19).Value = 0
    End If
    If IsEmpty(ЛистИсточник.Cells(31 + i, 13).Value) = False Then
        ЛистКонечный.Cells(LastRowКонечный + j, 20).Value = ЛистИсточник.Cells(31 + i, 13).Value
    Else
        ЛистКонечный.Cells(LastRowКонечный + j, 20).Value = 0
    End If
    If IsEmpty(ЛистИсточник.Cells(31 + i, 12).Value) = False Then
        ЛистКонечный.Cells(LastRowКонечный + j, 21).Value = ЛистИсточник.Cells(31 + i, 12).Value
    Else
        ЛистКонечный.Cells(LastRowКонечный + j, 21).Value = 0
    End If
    If IsEmpty(ЛистИсточник.Cells(31 + i, 8).Value) = False Then
        ЛистКонечный.Cells(LastRowКонечный + j, 23).Value = ЛистИсточник.Cells(31 + i, 8).Value
    Else
        ЛистКонечный.Cells(LastRowКонечный + j, 23).Value = 0
    End If
    If IsEmpty(ЛистИсточник.Cells(31 + i, 7).Value) = False Then
        ЛистКонечный.Cells(LastRowКонечный + j, 24).Value = ЛистИсточник.Cells(31 + i, 7).Value
    Else
        ЛистКонечный.Cells(LastRowКонечный + j, 24).Value = 0
    End If
    If IsEmpty(ЛистИсточник.Cells(31 + i, 6).Value) = False Then
        ЛистКонечный.Cells(LastRowКонечный + j, 25).Value = ЛистИсточник.Cells(31 + i, 6).Value
    Else
        ЛистКонечный.Cells(LastRowКонечный + j, 25).Value = 0
    End If
Next i
With ЛистКонечный
    .Cells(LastRowКонечный + 1, 4).Value = ЛистИсточник.Cells(8, 4).Value
    .Range(.Cells(LastRowКонечный + 1, 4), .Cells(LastRowКонечный + СколькоОбъединять, 4)).Merge
    .Cells(LastRowКонечный + 1, 5).Value = ЛистИсточник.Cells(10, 4).Value
    .Range(.Cells(LastRowКонечный + 1, 5), .Cells(LastRowКонечный + СколькоОбъединять, 5)).Merge
    .Cells(LastRowКонечный + 1, 6).Value = ЛистИсточник.Cells(11, 4).Value
    .Range(.Cells(LastRowКонечный + 1, 6), .Cells(LastRowКонечный + СколькоОбъединять, 6)).Merge
    .Cells(LastRowКонечный + 1, 7).Value = ЛистИсточник.Cells(20, 4).Value
    .Range(.Cells(LastRowКонечный + 1, 7), .Cells(LastRowКонечный + СколькоОбъединять, 7)).Merge
    .Cells(LastRowКонечный + 1, 8).Value = ЛистИсточник.Cells(10, 11).Value
    .Range(.Cells(LastRowКонечный + 1, 8), .Cells(LastRowКонечный + СколькоОбъединять, 8)).Merge
    .Cells(LastRowКонечный + 1, 11).Value = ЛистИсточник.Cells(17, 11).Value
    .Range(.Cells(LastRowКонечный + 1, 11), .Cells(LastRowКонечный + СколькоОбъединять, 11)).Merge
    .Cells(LastRowКонечный + 1, 12).Value = ЛистИсточник.Cells(17, 15).Value
    .Range(.Cells(LastRowКонечный + 1, 12), .Cells(LastRowКонечный + СколькоОбъединять, 12)).Merge
End With
'Делаем запись на добавленном в конечную книгу листе, что данный файл-источник обработан.
With Workbooks("Конечный.xls").Worksheets("Имена файлов")
    .Range("A" & .Cells.SpecialCells(xlCellTypeLastCell).Row + 1) = ActiveWorkbook.Name
End With
'Сохранение измений в конечной книге.
Workbooks("Конечный.xls").Save
'Просто сообщение, что работа макроса завершена.
MsgBox "Данные из файла-источника взяты", vbInformation
End Sub

Ещё будет макрос для проверки, все ли файлы-источники были обработаны или нет.

@Busine2009 · 26.01.2011, 14:16

Внесены изменения в пояснительную записку.

@lalike · 26.01.2011, 14:54 **[ТС]**

СПАСИБО BUSINE2009!!!!

Все РАБОТАЕТ!!!

@Busine2009 · 26.01.2011, 18:25

Вариант с автоматическим открытием всех файлов-источников из указанной папки. Оказывается в Excel во время выполнения макроса есть возможность выделять ячейки и перемещаться по листу: для этого нужно использовать метод InputBox (не путать с функцией InputBox). Перед использованием кода прочтите Руководство пользователю.

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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
Sub m_1()
Dim ЛистИсточник As Excel.Worksheet
Dim ФайлИсточник As Excel.Workbook
Dim ЛистСводный As Excel.Worksheet
Dim oFileSystemObject As Scripting.FileSystemObject
Dim oFolder As Scripting.Folder
Dim oFile As Scripting.File
Dim ИмяПапки As String
Dim Response As String
Dim АктивнаяЯчейка As Range
Dim i As Long
Dim j As Long
Dim LastRowИсточник As Long
Dim LastRowСводный As Long
Dim СколькоОбъединять As Long
Dim Сумма
'Выбор папки, содержащей файлы-источники.
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then Exit Sub
        ИмяПапки = .SelectedItems(1)
    End With
'Проверка, что выбрана нужная папка.
    Response = MsgBox("Выбрана папка " & ИмяПапки, vbOKCancel)
    If Response = vbCancel Then Exit Sub
'Активизация объектов, связанных с работой с файлами.
    Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFileSystemObject.GetFolder(ИмяПапки)
'Проверка, что в папке нет файлов, кроме файлов Excel.
    For Each oFile In oFolder.Files
        If InStr(oFile.Type, "Excel") = 0 Then
            MsgBox "В выбранной папке есть файлы недопустимых форматов (не Excel).", vbCritical
            Exit Sub
        End If
    Next oFile
'Собственно заполнение сводного файла данными из файлов-источников.
    For Each oFile In oFolder.Files
        Set ФайлИсточник = Workbooks.Open(oFile.Path)
        Set ЛистИсточник = ФайлИсточник.Worksheets(1)
        Set ЛистСводный = Workbooks("Сводный.xls").Worksheets(1)
        LastRowСводный = ЛистСводный.Cells.SpecialCells(xlCellTypeLastCell).Row
metka_1:
        Set АктивнаяЯчейка = Application.InputBox("Выберите ячейку: R1C1, последнюю ячейку " & _
            "столбца C11 или последнюю ячейку столбца C17.", Type:=8)
        If АктивнаяЯчейка.Address(ReferenceStyle:=xlR1C1) = "R1C1" Then
            ЛистСводный.Cells(LastRowСводный + 1, 4).Value = ЛистИсточник.Cells(8, 4).Value
            ЛистСводный.Cells(LastRowСводный + 1, 5).Value = ЛистИсточник.Cells(10, 4).Value
            ЛистСводный.Cells(LastRowСводный + 1, 6).Value = ЛистИсточник.Cells(11, 4).Value
            ЛистСводный.Cells(LastRowСводный + 1, 7).Value = ЛистИсточник.Cells(20, 4).Value
            ЛистСводный.Cells(LastRowСводный + 1, 8).Value = ЛистИсточник.Cells(10, 11).Value
            ЛистСводный.Cells(LastRowСводный + 1, 11).Value = ЛистИсточник.Cells(17, 11).Value
            ЛистСводный.Cells(LastRowСводный + 1, 12).Value = ЛистИсточник.Cells(17, 15).Value
            ЛистСводный.Cells(LastRowСводный + 1, 15).Value = 0
            ЛистСводный.Cells(LastRowСводный + 1, 17).Value = 0
            ЛистСводный.Cells(LastRowСводный + 1, 19).Value = 0
            ЛистСводный.Cells(LastRowСводный + 1, 20).Value = 0
            ЛистСводный.Cells(LastRowСводный + 1, 21).Value = 0
            ЛистСводный.Cells(LastRowСводный + 1, 22).Value = 0
            ЛистСводный.Cells(LastRowСводный + 1, 23).Value = 0
            ЛистСводный.Cells(LastRowСводный + 1, 24).Value = 0
            ЛистСводный.Cells(LastRowСводный + 1, 25).Value = 0
            ЛистСводный.Cells(LastRowСводный + 1, 26).Value = 0
            GoTo metka_2
        ElseIf АктивнаяЯчейка.Column <> 11 And АктивнаяЯчейка.Column <> 17 Or _
            IsNumeric(АктивнаяЯчейка) = False Or АктивнаяЯчейка.Font.Bold = False Then
            MsgBox "Выделенными ячейками могут быть только R1C1, последняя ячейка столбца C11 или последняя ячейка столбца C17." & vbCr & _
                "Если это последняя ячейка столбца C11 или столбца C17, то проверьте форматирование этой ячейки: " & vbCr & _
                "в этой ячейке должно быть число и шрифт должен быть жирным." & vbCr & vbCr & _
                "Повторите выбор ячейки.", vbCritical
                GoTo metka_1
        End If
        LastRowИсточник = АктивнаяЯчейка.Row
        'Заполним сначала столбец 17 в конечном файле, чтобы знать, сколько объединять ячеек в дальнейшем.
        For i = 1 To LastRowИсточник - 31 Step 2
            If IsEmpty(ЛистИсточник.Cells(31 + i, 1).Value) = False Then
                j = j + 1
                ЛистСводный.Cells(LastRowСводный + j, 17).Value = ЛистИсточник.Cells(31 + i, 1).Value
            End If
        Next i
        j = 0
        СколькоОбъединять = ЛистСводный.Cells.SpecialCells(xlCellTypeLastCell).Row - LastRowСводный
        'Будем отдельно заносить данные в отношении ячеек конечного файла, имеющих и не имеющих объединение.
        'Сначала поработаем с теми ячейками, которые нужно объединить.
        '15 столбец
            For i = 1 To LastRowИсточник - 31 Step 2
                If IsEmpty(ЛистИсточник.Cells(31 + i, 12).Value) = False Then
                    Сумма = Сумма + ЛистИсточник.Cells(31 + i, 12).Value
                End If
            Next i
            ЛистСводный.Cells(LastRowСводный + 1, 15).Value = Сумма
            With ЛистСводный
                .Range(.Cells(LastRowСводный + 1, 15), .Cells(LastRowСводный + СколькоОбъединять, 15)).Merge
            End With
        '22 столбец
            If IsEmpty(ЛистИсточник.Cells(LastRowИсточник, 17).Value) = False Then
                ЛистСводный.Cells(LastRowСводный + 1, 22).Value = ЛистИсточник.Cells(LastRowИсточник, 17).Value
            Else
                ЛистСводный.Cells(LastRowСводный + 1, 22).Value = 0
            End If
            With ЛистСводный
                .Range(.Cells(LastRowСводный + 1, 22), .Cells(LastRowСводный + СколькоОбъединять, 22)).Merge
            End With
        '26 столбец
            If IsEmpty(ЛистИсточник.Cells(LastRowИсточник, 11).Value) = False Then
                ЛистСводный.Cells(LastRowСводный + 1, 26).Value = ЛистИсточник.Cells(LastRowИсточник, 11).Value
            Else
                ЛистСводный.Cells(LastRowСводный + 1, 26).Value = 0
            End If
            With ЛистСводный
                .Range(.Cells(LastRowСводный + 1, 26), .Cells(LastRowСводный + СколькоОбъединять, 26)).Merge
            End With
        'Теперь с необъединёнными ячейками поработаем.
        For i = 1 To LastRowИсточник - 32 Step 2
            j = j + 1
            If IsEmpty(ЛистИсточник.Cells(31 + i, 14).Value) = False Then
                ЛистСводный.Cells(LastRowСводный + j, 19).Value = ЛистИсточник.Cells(31 + i, 14).Value
            Else
                ЛистСводный.Cells(LastRowСводный + j, 19).Value = 0
            End If
            If IsEmpty(ЛистИсточник.Cells(31 + i, 13).Value) = False Then
                ЛистСводный.Cells(LastRowСводный + j, 20).Value = ЛистИсточник.Cells(31 + i, 13).Value
            Else
                ЛистСводный.Cells(LastRowСводный + j, 20).Value = 0
            End If
            If IsEmpty(ЛистИсточник.Cells(31 + i, 12).Value) = False Then
                ЛистСводный.Cells(LastRowСводный + j, 21).Value = ЛистИсточник.Cells(31 + i, 12).Value
            Else
                ЛистСводный.Cells(LastRowСводный + j, 21).Value = 0
            End If
            If IsEmpty(ЛистИсточник.Cells(31 + i, 8).Value) = False Then
                ЛистСводный.Cells(LastRowСводный + j, 23).Value = ЛистИсточник.Cells(31 + i, 8).Value
            Else
                ЛистСводный.Cells(LastRowСводный + j, 23).Value = 0
            End If
            If IsEmpty(ЛистИсточник.Cells(31 + i, 7).Value) = False Then
                ЛистСводный.Cells(LastRowСводный + j, 24).Value = ЛистИсточник.Cells(31 + i, 7).Value
            Else
                ЛистСводный.Cells(LastRowСводный + j, 24).Value = 0
            End If
            If IsEmpty(ЛистИсточник.Cells(31 + i, 6).Value) = False Then
                ЛистСводный.Cells(LastRowСводный + j, 25).Value = ЛистИсточник.Cells(31 + i, 6).Value
            Else
                ЛистСводный.Cells(LastRowСводный + j, 25).Value = 0
            End If
        Next i
        With ЛистСводный
            .Cells(LastRowСводный + 1, 4).Value = ЛистИсточник.Cells(8, 4).Value
            .Range(.Cells(LastRowСводный + 1, 4), .Cells(LastRowСводный + СколькоОбъединять, 4)).Merge
            .Cells(LastRowСводный + 1, 5).Value = ЛистИсточник.Cells(10, 4).Value
            .Range(.Cells(LastRowСводный + 1, 5), .Cells(LastRowСводный + СколькоОбъединять, 5)).Merge
            .Cells(LastRowСводный + 1, 6).Value = ЛистИсточник.Cells(11, 4).Value
            .Range(.Cells(LastRowСводный + 1, 6), .Cells(LastRowСводный + СколькоОбъединять, 6)).Merge
            .Cells(LastRowСводный + 1, 7).Value = ЛистИсточник.Cells(20, 4).Value
            .Range(.Cells(LastRowСводный + 1, 7), .Cells(LastRowСводный + СколькоОбъединять, 7)).Merge
            .Cells(LastRowСводный + 1, 8).Value = ЛистИсточник.Cells(10, 11).Value
            .Range(.Cells(LastRowСводный + 1, 8), .Cells(LastRowСводный + СколькоОбъединять, 8)).Merge
            .Cells(LastRowСводный + 1, 11).Value = ЛистИсточник.Cells(17, 11).Value
            .Range(.Cells(LastRowСводный + 1, 11), .Cells(LastRowСводный + СколькоОбъединять, 11)).Merge
            .Cells(LastRowСводный + 1, 12).Value = ЛистИсточник.Cells(17, 15).Value
            .Range(.Cells(LastRowСводный + 1, 12), .Cells(LastRowСводный + СколькоОбъединять, 12)).Merge
        End With
metka_2:
        ФайлИсточник.Close
        j = 0
        СколькоОбъединять = 0
        Сумма = 0
    Next oFile
'Просто сообщение, что работа макроса завершена.
    MsgBox "Сбор данных из файлов-источников завершён.", vbInformation
End Sub

@lalike · 27.01.2011, 09:51 **[ТС]**

СПАСИБО!!!!
использовал на все 100%.
очень удобно и сэкономило столько времени.

я вот думаю, как бы сделать эту програмку универсальной..

@Busine2009 · 27.01.2011, 09:56

lalike,
в смысле "универсальной"? Начните изучать потихоньку VBA, я помогу на первых порах, т.к. обладаю только неполными базовыми знаниями. И будете превращать этот код в универсальный.

@lalike · 27.01.2011, 11:16 **[ТС]**

отлично! огромное спасибо, я сейчас читаю А. Гарнаева, Самоучитель VBA.

@Busine2009 · 27.01.2011, 11:18

lalike,
что ты именно читаешь? Какой раздел этой книги и для чего ты читаешь этот раздел книги?

@lalike · 27.01.2011, 12:41 **[ТС]**

еще вот посоветовали
Дж. Уокенбаха. "Профессиональное программирование на VBA в Excel 2002 (2003)", "Подробное руководство по созданию формул в Excel"

Busine2009, я пока знакомлюсь в целом.

а у меня еще такой вопрос,
в файле источнике в столбе X строке Y брались данные,

потом в другом файле в столбе X1 сверялось с данными и если в строке Y1 оно сошлось, то бралось бы значение из столба Z1 строки Y1

и вставлялось бы в файл источник в столб Z строку Y?

@Busine2009 · 27.01.2011, 12:48

lalike,
а что в книге Уокенбаха по этому вопросу написано?
Или сначала надо прочитать 500 страниц, мысленно представляя себе работу кода, чтобы решить эту задачу?

Я бы использовал Find для поиска в файле нужной информации, и Offcet, чтобы брать или вставлять данные относительно определённой ячейки.

@lalike · 27.01.2011, 13:52 **[ТС]**

=ИНДЕКС(Sheet1!$C$3:$K$2848;ПОИСКПОЗ(D30 28;Sheet1!$C$4:$C$2849;0);9)

как то так?)

@Busine2009 · 27.01.2011, 17:14

lalike,
у тебя функции Excel используются. Я в Excel практически не работал, поэтому не могу сказать, правильно у тебя или нет, к тому же я задачу твою понял не до конца.

Я говорил про инструменты VBA.

Добавлено через 3 часа 10 минут

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

=ИНДЕКС(Sheet1!$C$3:$K$2848;ПОИСКПОЗ(D30 28;Sheet1!$C$4:$C$2849;0);9)

у вас эта формула работает? Я просто с формулами редко имел дело. Т.е. в одну формулу можно 2 формулы засунуть?

@lalike · 28.01.2011, 06:08 **[ТС]**

да, можно.
она работает, но для других диапазонов

@Busine2009 · 28.01.2011, 10:13

lalike,
надо попробовать формулы Excel обуздать для вашей задачи. У вас хорошая идея.
Я создал ситуация, что ваша формула наконец у меня заработала.

22.09.2011, 13:35

Подскажите как будет выглядеть код если ситуация попроще:
Есть около 1000 файлов с абсолютно одинаковыми таблицами (отличаются только данные) и необходимо получить в сводный файл такую же таблицу но содержащую результат обработки исходных таблиц ( например сумму значений соответствующих ячеек) ?

Новые блоги и статьи Все статьи Все блоги /
Программное добавление префикса в нумерацию документов Maks 27.10.2026 Реализация из решения ниже выполнена в самописной конфигурации на БСП (помощь начинающему коллеге). Задача: Программно добавить префикс в нумерацию документов. Решение: В модуле объекта. . .	После закрытия оутлука продолжает висеть процесс в диспетчере задач Maks 27.10.2026 С недавнего времени в продакшене возникла проблема: при закрытии оутлука в диспетчере задач продолжал висеть процесс outlook. exe. Проблема возникла после установки MS Office 2021 LTSC на машинах, под. . .	Baragoz - DPS/HPS бот для WoW 3.3.5a, многоязычный AmbA 26.10.2026 Хотите ещё ботов? У меня есть один! А я пока отдохну от него. https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=12062&stc=1&d=1793007952 Инструкция внутри. https:/ / youtu. be/ VpfFZSUDGnQ. . .	Особенности gif сгенерированных в Си russiannick 21.10.2026 Рассмотрим генерацию gif файлов, которые в Си имеют свои особенности. Gif представляет собой графический формат популярный в интернете. Посмотрим на палитру. Gif файл сгенерированный в си отличается. . .
FPS контроллер с анимированными Y-Bot и 3D-звуком miniaudio (Box3D, Recast, BehaviorTree.CPP, ozz-animation, ImGui, OpenGL и SDL3) 8Observer8 18.10.2026 Содержание блога \| English Version Полное мультиплатформенное руководство по стартовому проекту с FPS-контроллером игрока, анимированными роботами Y-Bot с 4-слойным блендингом, 3D-физикой Box3D,. . .	Локальный http сервер Argus19 17.10.2026 Локальный http сервер На работе, на двух локальных компьютерах круглосуточно работают программы опроса приборов с записью в книги Excel,которые раз в сутки записываются на сервер компании. Т. к. . . .	Копировать Windows на новый диск на UEFI damix 17.10.2026 https:/ / uriesk. wordpress. com/ 2016/ 11/ 01/ move-window-10-to-ssd-on-a-uefi-dualboot-system-with-basic-linux-tools/ TL DR Вставляем диск, а старый подключаем через переходник, грузимся с лайва. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .

@lalike 0 / 0 / 0 Регистрация: 24.01.2011 Сообщений: 29
	26.01.2011, 13:16 [ТС]
	Добавлено через 22 секунды у меня просто проходит цикл, но ничего не вставляет Добавлено через 32 минуты а как сделать так, чтобы в файле источнике в столбе X строке Y брались данные, потом в другом файле в столбе X1 сверялось с данными и если в строке Y1 оно сошлось, то бралось бы значение из столба Z1 строки Y1 и вставлялось бы в файл источник в столб Z строку Y? 0

@lalike 0 / 0 / 0 Регистрация: 24.01.2011 Сообщений: 29
	26.01.2011, 14:54 [ТС]
	СПАСИБО BUSINE2009!!!! Все РАБОТАЕТ!!! 0

@lalike 0 / 0 / 0 Регистрация: 24.01.2011 Сообщений: 29
	27.01.2011, 09:51 [ТС]
	СПАСИБО!!!! использовал на все 100%. очень удобно и сэкономило столько времени. я вот думаю, как бы сделать эту програмку универсальной.. 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	27.01.2011, 09:56
	lalike, в смысле "универсальной"? Начните изучать потихоньку VBA, я помогу на первых порах, т.к. обладаю только неполными базовыми знаниями. И будете превращать этот код в универсальный. 0

@lalike 0 / 0 / 0 Регистрация: 24.01.2011 Сообщений: 29
	27.01.2011, 11:16 [ТС]
	отлично! огромное спасибо, я сейчас читаю А. Гарнаева, Самоучитель VBA. 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	27.01.2011, 11:18
	lalike, что ты именно читаешь? Какой раздел этой книги и для чего ты читаешь этот раздел книги? 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	27.01.2011, 12:48
	lalike, а что в книге Уокенбаха по этому вопросу написано? Или сначала надо прочитать 500 страниц, мысленно представляя себе работу кода, чтобы решить эту задачу? Я бы использовал Find для поиска в файле нужной информации, и Offcet, чтобы брать или вставлять данные относительно определённой ячейки. 0

@lalike 0 / 0 / 0 Регистрация: 24.01.2011 Сообщений: 29
	27.01.2011, 13:52 [ТС]
	=ИНДЕКС(Sheet1!$C$3:$K$2848;ПОИСКПОЗ(D30 28;Sheet1!$C$4:$C$2849;0);9) как то так?) 0

@lalike 0 / 0 / 0 Регистрация: 24.01.2011 Сообщений: 29
	28.01.2011, 06:08 [ТС]
	да, можно. она работает, но для других диапазонов 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	28.01.2011, 10:13
	lalike, надо попробовать формулы Excel обуздать для вашей задачи. У вас хорошая идея. Я создал ситуация, что ваша формула наконец у меня заработала. 0

booleg
	22.09.2011, 13:35
	Подскажите как будет выглядеть код если ситуация попроще: Есть около 1000 файлов с абсолютно одинаковыми таблицами (отличаются только данные) и необходимо получить в сводный файл такую же таблицу но содержащую результат обработки исходных таблиц ( например сумму значений соответствующих ячеек) ?