Обрыл интернет...но ничего подходящего не нашел...
Нужно, чтобы из книг с Лист1 из отдельной папки копировались данные в отдельную книгу на один лист.
Изначально есть статичная ChDir (адрес папки не планирует меняться) В этой папке лежат книги. В книгах в листах1 в Cells (1,5) Cells (3,5) и Cells (Lr, 1) лежит нужная информация.
Мне нужно ее запарсить в отдельную книгу.
Знаю, что из примера в нете нужно циклом просматривать все книги директории... Но комплексно я не понимаю...
Должно быть что - то
[vba]
Код
fPATH = "C:\2011\GroupFiles\" 'remember the final \ in this string
fNAME = Dir(fPATH & "*.xls") 'get the first filename in fpath
[/vba] [vba]
Код
ActiveWorkbook.Add....)) lr = Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row
i = Sheets("Лист1").Cells(Rows.Count, "A").End(xlUp).Row + 1
[/vba] Вообщем, прошу помочь. Пример прилагаю. В лист1 пример расположения нужных данных, как он в книгах, откуда брать. В лист 2 пример(пример отдельной книги для сбора данных), куда вставлять. Подскажите, пожалуйста....
Не понимаю, как 1) Запрашивать данные из всех книг 2) Бежать циклом по книгам
Есть, конечно, пример с power query, но он "длинный...." по исполнению. Хотел бы научиться через VBA.
Добрый вечер всем!
Обрыл интернет...но ничего подходящего не нашел...
Нужно, чтобы из книг с Лист1 из отдельной папки копировались данные в отдельную книгу на один лист.
Изначально есть статичная ChDir (адрес папки не планирует меняться) В этой папке лежат книги. В книгах в листах1 в Cells (1,5) Cells (3,5) и Cells (Lr, 1) лежит нужная информация.
Мне нужно ее запарсить в отдельную книгу.
Знаю, что из примера в нете нужно циклом просматривать все книги директории... Но комплексно я не понимаю...
Должно быть что - то
[vba]
Код
fPATH = "C:\2011\GroupFiles\" 'remember the final \ in this string
fNAME = Dir(fPATH & "*.xls") 'get the first filename in fpath
[/vba] [vba]
Код
ActiveWorkbook.Add....)) lr = Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row
i = Sheets("Лист1").Cells(Rows.Count, "A").End(xlUp).Row + 1
[/vba] Вообщем, прошу помочь. Пример прилагаю. В лист1 пример расположения нужных данных, как он в книгах, откуда брать. В лист 2 пример(пример отдельной книги для сбора данных), куда вставлять. Подскажите, пожалуйста....
Не понимаю, как 1) Запрашивать данные из всех книг 2) Бежать циклом по книгам
Есть, конечно, пример с power query, но он "длинный...." по исполнению. Хотел бы научиться через VBA.ant6729
Sub tt() Dim wb_ As Workbook Application.ScreenUpdating = False fp_ = "D:\Стереть\1\" fn_ = Dir(fp_ & "*.xls*", vbNormal) On Error Resume Next Do While fn_ <> "" Set wb_ = GetObject(fp_ & fn_) With wb_.Sheets("Лист1") lr_ = .Cells(.Rows.Count, 1).End(xlUp).Row If Not IsEmpty(lr_) Then'если нет Лист1 n_ = n_ + 1 Cells(n_, 1).Value = .Cells(1, 5).Value Cells(n_, 2).Value = .Cells(3, 5).Value Cells(n_, 3).Value = .Cells(lr_, 1).Value End If End With wb_.Close False lr_ = Empty fn_ = Dir() Loop End Sub
[/vba]
Примерно это нужно? [vba]
Код
Sub tt() Dim wb_ As Workbook Application.ScreenUpdating = False fp_ = "D:\Стереть\1\" fn_ = Dir(fp_ & "*.xls*", vbNormal) On Error Resume Next Do While fn_ <> "" Set wb_ = GetObject(fp_ & fn_) With wb_.Sheets("Лист1") lr_ = .Cells(.Rows.Count, 1).End(xlUp).Row If Not IsEmpty(lr_) Then'если нет Лист1 n_ = n_ + 1 Cells(n_, 1).Value = .Cells(1, 5).Value Cells(n_, 2).Value = .Cells(3, 5).Value Cells(n_, 3).Value = .Cells(lr_, 1).Value End If End With wb_.Close False lr_ = Empty fn_ = Dir() Loop End Sub
Как логическое продолжение этой темы , если нет, создам новую тему (Получить данные к имеющимся в первом цикле) Есть, по сути, код выще....:
[vba]
Код
Sub ttu() Dim wb_ As Workbook Application.ScreenUpdating = False fp_ = "F:\1\" fn_ = Dir(fp_ & "*.xls*", vbNormal) On Error Resume Next Do While fn_ <> "" Set wb_ = GetObject(fp_ & fn_) With wb_.Sheets("Лист1") lr_ = .Cells(.Rows.Count, 1).End(xlUp).Row If Not IsEmpty(lr_) Then u = .Cells(1, 5).Value s = .Cells(3, 5).Value b = .Cells(lr_, 1).Value Lc = Sheets("Лист1").Cells(10, Sheets("Лист1").Columns.Count).End(xlToLeft).Column ' на листе активной книги ищу следующий день, нахожу номер колонки: For i = 8 To Lc If Cells(4, i).Value = Date + 1 Then a = Cells(4, i).Column Next i
lr = Cells(Rows.Count, 9).End(xlUp).Row ' иду вниз, заполняю колонку: For i = 11 To lr If Cells(i, 3).Value = s Then Cells(i, a).Value = UCase(u) & " " & b Next i End If End With wb_.Close False lr_ = Empty fn_ = Dir() Loop End Sub
[/vba]
Суть вопроса в том, как сделать так, чтобы если у меня два и более документов, которые парсятся из папки и в них одинаковые s, то чтобы вот этот кусок [vba]
Код
If Cells(i, 3).Value = s Then Cells(i, a).Value = UCase(u) & " " & b
[/vba] не шлепал мне сверху вместо уже написанного первого значения последнее в цикле, а добавлял к уже имеющемуся типа [vba]
Код
Cells(i, a).Value & " " & UCase(u) & " " & b
[/vba]
Наиболее близко решил только так, но это ни то... потому что пусть и бахает в дополнение, но несколько раз. А надо, чтобы один.Привязывался к наличию/отсутствию значений в ячейке. Но понял, что нужно циклить, но как, не понимаю. [vba]
Код
'Select Case Cells(i, a).Value ' если пустая ячейка, то 'Case Is = "" 'Select Case Cells(i, 3).Value 'Case Is = s 'Cells(i, a).Value = UCase(u) & " " & b & 'End Select 'End Select ' если не пустая, то добавляет, но добавляет нужное несколько раз 'Select Case Cells(i, a).Value 'Case Is > 0 'Select Case Cells(i, 3).Value 'Case Is = s 'Cells(i, a).Value = Cells(i, a).Value & UCase(u) & " " & b 'End Select 'End Select
[/vba]
Вообщем... под утро понял, что масштаб этого вопрос выходит за рамки моего опыта
Помогите, пожалуйста, с этим. Расширьте опыт )
Надеюсь, никого не запутал. Файл, для визуализации приложил.
Всем привет!
Как логическое продолжение этой темы , если нет, создам новую тему (Получить данные к имеющимся в первом цикле) Есть, по сути, код выще....:
[vba]
Код
Sub ttu() Dim wb_ As Workbook Application.ScreenUpdating = False fp_ = "F:\1\" fn_ = Dir(fp_ & "*.xls*", vbNormal) On Error Resume Next Do While fn_ <> "" Set wb_ = GetObject(fp_ & fn_) With wb_.Sheets("Лист1") lr_ = .Cells(.Rows.Count, 1).End(xlUp).Row If Not IsEmpty(lr_) Then u = .Cells(1, 5).Value s = .Cells(3, 5).Value b = .Cells(lr_, 1).Value Lc = Sheets("Лист1").Cells(10, Sheets("Лист1").Columns.Count).End(xlToLeft).Column ' на листе активной книги ищу следующий день, нахожу номер колонки: For i = 8 To Lc If Cells(4, i).Value = Date + 1 Then a = Cells(4, i).Column Next i
lr = Cells(Rows.Count, 9).End(xlUp).Row ' иду вниз, заполняю колонку: For i = 11 To lr If Cells(i, 3).Value = s Then Cells(i, a).Value = UCase(u) & " " & b Next i End If End With wb_.Close False lr_ = Empty fn_ = Dir() Loop End Sub
[/vba]
Суть вопроса в том, как сделать так, чтобы если у меня два и более документов, которые парсятся из папки и в них одинаковые s, то чтобы вот этот кусок [vba]
Код
If Cells(i, 3).Value = s Then Cells(i, a).Value = UCase(u) & " " & b
[/vba] не шлепал мне сверху вместо уже написанного первого значения последнее в цикле, а добавлял к уже имеющемуся типа [vba]
Код
Cells(i, a).Value & " " & UCase(u) & " " & b
[/vba]
Наиболее близко решил только так, но это ни то... потому что пусть и бахает в дополнение, но несколько раз. А надо, чтобы один.Привязывался к наличию/отсутствию значений в ячейке. Но понял, что нужно циклить, но как, не понимаю. [vba]
Код
'Select Case Cells(i, a).Value ' если пустая ячейка, то 'Case Is = "" 'Select Case Cells(i, 3).Value 'Case Is = s 'Cells(i, a).Value = UCase(u) & " " & b & 'End Select 'End Select ' если не пустая, то добавляет, но добавляет нужное несколько раз 'Select Case Cells(i, a).Value 'Case Is > 0 'Select Case Cells(i, 3).Value 'Case Is = s 'Cells(i, a).Value = Cells(i, a).Value & UCase(u) & " " & b 'End Select 'End Select
[/vba]
Вообщем... под утро понял, что масштаб этого вопрос выходит за рамки моего опыта
Помогите, пожалуйста, с этим. Расширьте опыт )
Надеюсь, никого не запутал. Файл, для визуализации приложил.ant6729
И еще вопрос в продолжение освоения "логики парсинга"
Если будет нужно, создам вопрос в новой теме (Парсинг массива из документов)
Просто все логически из одного кода...
Пробую на массиве код выше... [vba]
Код
Sub ttu() Dim wb_ As Workbook Application.ScreenUpdating = False fp_ = "F:\1\" fn_ = Dir(fp_ & "*.xls*", vbNormal) On Error Resume Next Do While fn_ <> "" Set wb_ = GetObject(fp_ & fn_)
End With wb_.Close False lr_ = Empty fn_ = Dir() Loop End Sub
[/vba]
Закомментированный кусок работает: тянет информацию с листа2 на лист1. В нем специально оставил нумерацию листов. Как есть. Чтобы объяснить, что я имею ввиду и хочу сделать.
То есть как логику применить, чтобы именно из запрашиваемых файлов копировалось в activebook? К сожалению, не уловил...
Двигал первые 4 строчки до [vba]
Код
With wb_.Sheets("Лист1")
[/vba] менял лист 2 на лист1.... Как это сделать, прошу помочь... Приложил файл... Для примера...пусть в лист2 как бы книга в папке, в лист1 - открытая книга для записи.
И еще вопрос в продолжение освоения "логики парсинга"
Если будет нужно, создам вопрос в новой теме (Парсинг массива из документов)
Просто все логически из одного кода...
Пробую на массиве код выше... [vba]
Код
Sub ttu() Dim wb_ As Workbook Application.ScreenUpdating = False fp_ = "F:\1\" fn_ = Dir(fp_ & "*.xls*", vbNormal) On Error Resume Next Do While fn_ <> "" Set wb_ = GetObject(fp_ & fn_)
End With wb_.Close False lr_ = Empty fn_ = Dir() Loop End Sub
[/vba]
Закомментированный кусок работает: тянет информацию с листа2 на лист1. В нем специально оставил нумерацию листов. Как есть. Чтобы объяснить, что я имею ввиду и хочу сделать.
То есть как логику применить, чтобы именно из запрашиваемых файлов копировалось в activebook? К сожалению, не уловил...
Двигал первые 4 строчки до [vba]
Код
With wb_.Sheets("Лист1")
[/vba] менял лист 2 на лист1.... Как это сделать, прошу помочь... Приложил файл... Для примера...пусть в лист2 как бы книга в папке, в лист1 - открытая книга для записи.ant6729
1) Не используйте select/selection, а также копирование через буфер, без необходимости. Аналогом для .select будет назначить нужный диапазон объектной переменной через Set, аналогом для selection. будет использовать назначенную переменную. Если копируете диапазоны - то метод .Copy имеет параметр Destination, который можно сразу же указать при вызове команды, прогонять данные через буфер нет необходимости.
2) Если вы обращаетесь к методам и свойствам (Cells,Range,Sheets,..) - то должны понимать, к какому объекту они при этом принадлежат [vba]
Код
Cells(1,3) ' ячейка "C1" активной книги Sheets("Лист1") ' лист с именем "Лист1" в активной книге With wb_.Sheets("Лист1") Sheets("Лист2") ' лист с именем "Лист2" активной книги .Sheets("Лист2") ' вызовет ошибку, потому что у объекта wb_.Sheets("Лист1") нет свойства Sheets Cells(1,3) ' ячейка "C1" активного листа активной книги .Cells(1,3) ' ячейка "C1" листа wb_.Sheets("Лист1") End With
[/vba] С Range и .Range надо обращаться ещё более аккуратно - ссылки на объекты в параметрах метода должны принадлежать тому же объекту, что и сам Range
3) Ваш "закомментированный кусок" мог бы выглядеть так: [vba]
Код
lr1 = Cells(Rows.Count, "A").End(xlUp).Row + 1 ' здесь Cells и Rows относятся к активному листу lr2 = .Range("a8:j8").End(xlDown).Row ' здесь .Range относится к with (листу-источнику) If lr2 >= 8 Then .Range("a8:j8").Resize(lr2 - 7).Copy Cells(lr1, 1) ' здесь .Range относится к листу-источнику, а Cells - к активному листу End If
[/vba]
1) Не используйте select/selection, а также копирование через буфер, без необходимости. Аналогом для .select будет назначить нужный диапазон объектной переменной через Set, аналогом для selection. будет использовать назначенную переменную. Если копируете диапазоны - то метод .Copy имеет параметр Destination, который можно сразу же указать при вызове команды, прогонять данные через буфер нет необходимости.
2) Если вы обращаетесь к методам и свойствам (Cells,Range,Sheets,..) - то должны понимать, к какому объекту они при этом принадлежат [vba]
Код
Cells(1,3) ' ячейка "C1" активной книги Sheets("Лист1") ' лист с именем "Лист1" в активной книге With wb_.Sheets("Лист1") Sheets("Лист2") ' лист с именем "Лист2" активной книги .Sheets("Лист2") ' вызовет ошибку, потому что у объекта wb_.Sheets("Лист1") нет свойства Sheets Cells(1,3) ' ячейка "C1" активного листа активной книги .Cells(1,3) ' ячейка "C1" листа wb_.Sheets("Лист1") End With
[/vba] С Range и .Range надо обращаться ещё более аккуратно - ссылки на объекты в параметрах метода должны принадлежать тому же объекту, что и сам Range
3) Ваш "закомментированный кусок" мог бы выглядеть так: [vba]
Код
lr1 = Cells(Rows.Count, "A").End(xlUp).Row + 1 ' здесь Cells и Rows относятся к активному листу lr2 = .Range("a8:j8").End(xlDown).Row ' здесь .Range относится к with (листу-источнику) If lr2 >= 8 Then .Range("a8:j8").Resize(lr2 - 7).Copy Cells(lr1, 1) ' здесь .Range относится к листу-источнику, а Cells - к активному листу End If
Я уже показал в п.3) что нужно делать Зачем тебе отдельные процедуры? Внимательно посмотри на него, особенно на использование/неиспользование . перед именами методов и свойств.
Про select/selection - это отдельный разговор. В текущем контексте решаемой задачи - их использование вообще не нужно, вот и всё.
Я уже показал в п.3) что нужно делать Зачем тебе отдельные процедуры? Внимательно посмотри на него, особенно на использование/неиспользование . перед именами методов и свойств.
Про select/selection - это отдельный разговор. В текущем контексте решаемой задачи - их использование вообще не нужно, вот и всё.AndreTM
Skype: andre.tm.007 Donate: Qiwi: 9517375010
Сообщение отредактировал AndreTM - Суббота, 10.06.2017, 19:45
lr2 мы искали, начиная с 8-й строки листа (a8:j8) в листе-источнике (.Range()), и он у нас содержит номер последней строки с данными в листе-источнике. При этом мы проверили, чтобы lr2 был точно не меньше 8. lr2-7 даёт нам количество строк данных в листе источнике (начиная с a8:j8) .Range("a8:j8").Resize(lr2 - 7) возьмёт указанный диапазон (состоящий из одной строки и 10 столбцов, начинается в "a8") и изменит его размеры на указанные (lr2-7 строк, т.е. столько строк, сколько имеется данных, и столько же столбцов, что и было). То есть мы получим весь диапазон, ссылающийся на данные в листе-источнике. Например, если данные занимали диапазон a8:j10, то lr2 = 10, lr2 - 7 = 3, копируемый диапазон = .Range("a8:j8").Resize(3) = "a8:j10"
А далее просто скопируем этот диапазон в лист-получатель, начиная с указанной нами ячейки на листе-получателе... Что касается понимания использования "." - то совет единственный: надо просто отвыкнуть использовать имена методов и свойств без точного указания на объект, которому они принадлежат. Для "начинающих в VBA" это обычно Cells, Sheets, Range, которые копипастятся из примеров, и вставляются в существующие "текущие", "активные" объекты, имеющие эти свойства - но в полной уверенности, что обращение пойдет к каким-то другим объектам/диапазонам :)
lr2 мы искали, начиная с 8-й строки листа (a8:j8) в листе-источнике (.Range()), и он у нас содержит номер последней строки с данными в листе-источнике. При этом мы проверили, чтобы lr2 был точно не меньше 8. lr2-7 даёт нам количество строк данных в листе источнике (начиная с a8:j8) .Range("a8:j8").Resize(lr2 - 7) возьмёт указанный диапазон (состоящий из одной строки и 10 столбцов, начинается в "a8") и изменит его размеры на указанные (lr2-7 строк, т.е. столько строк, сколько имеется данных, и столько же столбцов, что и было). То есть мы получим весь диапазон, ссылающийся на данные в листе-источнике. Например, если данные занимали диапазон a8:j10, то lr2 = 10, lr2 - 7 = 3, копируемый диапазон = .Range("a8:j8").Resize(3) = "a8:j10"
А далее просто скопируем этот диапазон в лист-получатель, начиная с указанной нами ячейки на листе-получателе... Что касается понимания использования "." - то совет единственный: надо просто отвыкнуть использовать имена методов и свойств без точного указания на объект, которому они принадлежат. Для "начинающих в VBA" это обычно Cells, Sheets, Range, которые копипастятся из примеров, и вставляются в существующие "текущие", "активные" объекты, имеющие эти свойства - но в полной уверенности, что обращение пойдет к каким-то другим объектам/диапазонам :)AndreTM
Skype: andre.tm.007 Donate: Qiwi: 9517375010
Сообщение отредактировал AndreTM - Суббота, 10.06.2017, 20:59