Добрый день!
Помогите, пожалуйста, откорректировать макрос, который бы копировал даты в сводную таблицу из нескольких отчётов.
Столбцы в отчётах всегда неизменные, а вот строки могут быть в любом порядке, поэтому нужно проверить содержат ли строки столбца D теги из сводной таблицы, и если да, то значение копируется в свод.
Задачу пыталась решить 3 циклами: сперва отрабатывается каждый файл отчета, затем каждый тег Сводной таблицы, а затем поиск тега в файле отчета.
Выдает ошибку несовместимости типа данных, хотя в усеченном варианте (1 цикл) макрос работает и ошибка не возникает.
Я совершенный новичок, приходится учиться и сразу же применять в работе.
Помогите, пожалуйста, откорректировать макрос, который бы копировал даты в сводную таблицу из нескольких отчётов.
Столбцы в отчётах всегда неизменные, а вот строки могут быть в любом порядке, поэтому нужно проверить содержат ли строки столбца D теги из сводной таблицы, и если да, то значение копируется в свод.
Задачу пыталась решить 3 циклами: сперва отрабатывается каждый файл отчета, затем каждый тег Сводной таблицы, а затем поиск тега в файле отчета.
Выдает ошибку несовместимости типа данных, хотя в усеченном варианте (1 цикл) макрос работает и ошибка не возникает.
Я совершенный новичок, приходится учиться и сразу же применять в работе.
| Код |
|---|
Sub Поиск_по_содержанию() Dim Ссылка As String, Имя As String, Тег As String, a As Byte, b As Byte, c As Byte a = 7 b = 16 c = 14 Do While IsEmpty(Cells(1, a)) = False Ссылка = ActiveSheet.Cells(6, a).Value Имя = ActiveSheet.Cells(4, a).Value Do While IsEmpty(Cells(5, b)) = False Тег = "* " + ActiveSheet.Cells(5, b).Value + " *" Workbooks.Open Ссылка 'открываем ссылку Do While IsEmpty(Workbooks(Имя).Worksheets(1).Cells(4,c)) = False If Workbooks(Имя).Worksheets(1).Cells(4, c) Like Тег Then 'если ячейка содержит тег Workbooks(Имя).Worksheets(1).Cells(4, c).Copy ThisWorkbook.Worksheets(1).Activate 'переходим в текущий лист Sheets(1).Paste Cells(b, a) 'копируем в ячейку в текущем листе End If c = c + 1 Loop Workbooks(Имя).Close 'закрываем исходник b = b + 1 Loop a = a + 1 Loop End Sub |
Изменено: - 29.06.2022 10:20:42
