Добавление функции проверки заголовка в макрос Excel - PullRequest
0 голосов
/ 08 мая 2020

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

Sub Import_Data()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim FileCnt As Byte


Call Entry_Point
Set WB1 = ActiveWorkbook
FileToOpen = Application.GetOpenFilename(Title:="Select your file", MultiSelect:=True, FileFilter:="Excel Files(*.xls*), *xls*")
If IsArray(FileToOpen) Then
For FileCnt = 1 To UBound(FileToOpen)
lrpaste = ThisWorkbook.Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row + 1
Set OpenBook = Application.Workbooks.Open(Filename:=FileToOpen(FileCnt))
lcol = Cells(2, Columns.Count).End(xlToLeft).Column
lrow = Cells(Rows.Count, lcol).End(xlUp).Row
OpenBook.Sheets(1).Range(("A2"), Cells(lrow, lcol)).Copy WB1.Sheets("Data").Range("A" & lrpaste)
OpenBook.Close True

Next FileCnt

End If


Call Exit_Point
End Sub

Теперь я хочу добавить функциональность, при которой макрос сначала считывает заголовок столбца основного файла, а затем сравнивает его с файлом, из которого необходимо импортировать данные. Если макрос обнаруживает тот же заголовок, он копирует данные под заголовком в основной файл. Это происходит до тех пор, пока все заголовки не будут записаны в основной файл. А затем перейдите к следующему файлу и сделайте то же самое.

Я смотрел учебник по VBA и получил код: -

c = 2  'columns needed for the summary sheet
                'use find function to match headers, since the template could have a different order of columns than the summary tab
                Do While shAll.Cells(1, c) <> ""
                    Set GetHeader = shNewDat.Rows(StartRowTemp).Find(what:=shAll.Cells(1, c).Value, LookIn:=xlValues, MatchCase:=False, lookat:=xlWhole)
                    If Not GetHeader Is Nothing Then
                        shNewDat.Range(shNewDat.Cells(StartRowTemp + 1, GetHeader.Column), shNewDat.Cells(LastTempRow, GetHeader.Column)).Copy
                        shAll.Cells(LastRow, c).PasteSpecial
                    End If
                    c = c + 1 'check and copy next column
               Loop

Я хочу интегрировать это в свой код. Однако я получаю много ошибок. Пожалуйста, помогите мне понять, как я могу добавить эту функциональность.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...