Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сбор данных по определенным листам в сводную таблицу - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сбор данных по определенным листам в сводную таблицу (Макросы/Sub)
Сбор данных по определенным листам в сводную таблицу
Santtic Дата: Пятница, 13.03.2020, 17:00 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
Всем добрый день. Сделал один файл для сбора данных из закрытого файла. Макрос найден и подправлен под себя на просторах интернета.Который вытягивает данные из закрытых файлов. Как бы все устраивает.
Есть еще теперь проблема вытянуть/скопировать данные с этих листов (название может измениться в дальнейшем сейчас названия временные) в сводный лист из которого наверное все де паверкверти будут тянуться данные.
Макрос который у меня есть, собирает данные вставляет в лист "Zvit" не корректно. Потому как данных может быть по 100 -200 и более строк. Он же вытягивает их не все заполненные строки да еще и кусок таблицы дорисовывает...
Помогите дописать макрос что бы он :
Вытягивал все данные с каждого листа поочередно
Когда вытягивал снова, то дописывал новые данные а не заменял их.
Данные вставлял начиная с 5 строки ( пожалуйста напишите коментарии в макросе, что бы я разобрался хоть немного)
Что бы при добавлении еще каких либо листов, макрос не считывал с них данные, так как файл будет расти дальше.
Спасибо.
К сообщению приложен файл: ___-_M.xlsm (48.4 Kb)
 
Ответить
СообщениеВсем добрый день. Сделал один файл для сбора данных из закрытого файла. Макрос найден и подправлен под себя на просторах интернета.Который вытягивает данные из закрытых файлов. Как бы все устраивает.
Есть еще теперь проблема вытянуть/скопировать данные с этих листов (название может измениться в дальнейшем сейчас названия временные) в сводный лист из которого наверное все де паверкверти будут тянуться данные.
Макрос который у меня есть, собирает данные вставляет в лист "Zvit" не корректно. Потому как данных может быть по 100 -200 и более строк. Он же вытягивает их не все заполненные строки да еще и кусок таблицы дорисовывает...
Помогите дописать макрос что бы он :
Вытягивал все данные с каждого листа поочередно
Когда вытягивал снова, то дописывал новые данные а не заменял их.
Данные вставлял начиная с 5 строки ( пожалуйста напишите коментарии в макросе, что бы я разобрался хоть немного)
Что бы при добавлении еще каких либо листов, макрос не считывал с них данные, так как файл будет расти дальше.
Спасибо.

Автор - Santtic
Дата добавления - 13.03.2020 в 17:00
Kuzmich Дата: Пятница, 13.03.2020, 18:17 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Цитата
Макрос который у меня есть, собирает данные вставляет в лист "Zvit" не корректно

Потому что у вас есть скрытые листы в книге и макрос при цикле по листам переносит данные и из скрытых листов.
На листе Zvit сделайте шапку, аналогичную остальным листам.
[vba]
Код
Sub Sbor11()
Dim Sht As Worksheet
Dim iLastRow As Long
Dim iLR As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
'Range("A10:K" & iLastRow).EntireRow.Clear '.Delete 'Clear
    For Each Sht In Worksheets
    If Sht.Name <> "Zvit" And Not Sht.Visible = xlSheetHidden Then
        With Sht
        iLR = .Cells(.Rows.Count, 5).End(xlUp).Row
        iLastRow = Cells(Rows.Count, 5).End(xlUp).Row + 1 '+
        If iLastRow < 5 Then iLastRow = 5
        .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Cells(iLastRow, 1)
        End With
    End If
    Next
End Sub
[/vba]
 
Ответить
Сообщение
Цитата
Макрос который у меня есть, собирает данные вставляет в лист "Zvit" не корректно

Потому что у вас есть скрытые листы в книге и макрос при цикле по листам переносит данные и из скрытых листов.
На листе Zvit сделайте шапку, аналогичную остальным листам.
[vba]
Код
Sub Sbor11()
Dim Sht As Worksheet
Dim iLastRow As Long
Dim iLR As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
'Range("A10:K" & iLastRow).EntireRow.Clear '.Delete 'Clear
    For Each Sht In Worksheets
    If Sht.Name <> "Zvit" And Not Sht.Visible = xlSheetHidden Then
        With Sht
        iLR = .Cells(.Rows.Count, 5).End(xlUp).Row
        iLastRow = Cells(Rows.Count, 5).End(xlUp).Row + 1 '+
        If iLastRow < 5 Then iLastRow = 5
        .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Cells(iLastRow, 1)
        End With
    End If
    Next
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 13.03.2020 в 18:17
Santtic Дата: Суббота, 14.03.2020, 10:37 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
Потому что у вас есть скрытые листы

Забыл о нем, он мне служит для формирования уникальных значений.
Спасибо, макрос работает супер.
Скажите пожалуйста, как прописать что бы макрос искал только на этих листах, т.е. в файл будут добавляться и не скрытые файлы. В нем будут вести учет, поэтому из этой таблицы сформируется минимум 15 таблиц. Каким образом это будет сделано,формулы, паверкверти, еще не знаем, но листы будут и не желательно чтобы с новых листов тянулась информация.
Кажись решил "проблему" с помощью дописи кода
[vba]
Код
If Sht.Name <> "Zvit" And Sht.Name = "ПВТР" Or Sht.Name = "Красноградський" Or Sht.Name = "Шебелинське" Or Sht.Name = "Стрійське" And Not Sht.Visible = xlSheetHidden Then
[/vba]
%) Протестировал, при условии, что если не на всех листах есть информация, макрос выпадает в ошибку. Странно


Сообщение отредактировал Santtic - Суббота, 14.03.2020, 11:45
 
Ответить
Сообщение
Потому что у вас есть скрытые листы

Забыл о нем, он мне служит для формирования уникальных значений.
Спасибо, макрос работает супер.
Скажите пожалуйста, как прописать что бы макрос искал только на этих листах, т.е. в файл будут добавляться и не скрытые файлы. В нем будут вести учет, поэтому из этой таблицы сформируется минимум 15 таблиц. Каким образом это будет сделано,формулы, паверкверти, еще не знаем, но листы будут и не желательно чтобы с новых листов тянулась информация.
Кажись решил "проблему" с помощью дописи кода
[vba]
Код
If Sht.Name <> "Zvit" And Sht.Name = "ПВТР" Or Sht.Name = "Красноградський" Or Sht.Name = "Шебелинське" Or Sht.Name = "Стрійське" And Not Sht.Visible = xlSheetHidden Then
[/vba]
%) Протестировал, при условии, что если не на всех листах есть информация, макрос выпадает в ошибку. Странно

Автор - Santtic
Дата добавления - 14.03.2020 в 10:37
RAN Дата: Суббота, 14.03.2020, 12:34 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Интересные условия.
Вот мне не удается представить себе, как имя листа может быть "ПВТР", и при этом еще и "Zvit".


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеИнтересные условия.
Вот мне не удается представить себе, как имя листа может быть "ПВТР", и при этом еще и "Zvit".

Автор - RAN
Дата добавления - 14.03.2020 в 12:34
Santtic Дата: Суббота, 14.03.2020, 12:38 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
как имя листа может быть "ПВТР", и при этом еще и "Zvit".

Как я думал, что тут обозначил - копировать с этих листов листов "or" а "<>" вставить в "Zvit"


Сообщение отредактировал Santtic - Суббота, 14.03.2020, 12:39
 
Ответить
Сообщение
как имя листа может быть "ПВТР", и при этом еще и "Zvit".

Как я думал, что тут обозначил - копировать с этих листов листов "or" а "<>" вставить в "Zvit"

Автор - Santtic
Дата добавления - 14.03.2020 в 12:38
Kuzmich Дата: Суббота, 14.03.2020, 12:46 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Цитата
как прописать что бы макрос искал только на этих листах

Соберите эти листы в массив и выбирайте данные только с них
[vba]
Код
ShtName = array("янв", "фев", "мар", "и пр.")
For i=LBound(ShtName) to UBound(ShtName)
  With WorkSheets(ShtName(i))
  ...
  End With
Next
[/vba]
Имена листов вставьте свои.
 
Ответить
Сообщение
Цитата
как прописать что бы макрос искал только на этих листах

Соберите эти листы в массив и выбирайте данные только с них
[vba]
Код
ShtName = array("янв", "фев", "мар", "и пр.")
For i=LBound(ShtName) to UBound(ShtName)
  With WorkSheets(ShtName(i))
  ...
  End With
Next
[/vba]
Имена листов вставьте свои.

Автор - Kuzmich
Дата добавления - 14.03.2020 в 12:46
RAN Дата: Суббота, 14.03.2020, 12:46 | Сообщение № 7
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
    For Each Sht In Worksheets
        If Sht.Visible Then
            Select Case Sht.Name
            Case "раз", "два", "три"
                With Sht
                    iLR = .Cells(.Rows.Count, 5).End(xlUp).Row
                    iLastRow = Sheets("Zvit").Cells(Sheets("Zvit").Rows.Count, 5).End(xlUp).Row + 1   '+
                    If iLastRow < 5 Then iLastRow = 5
                    .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Sheets("Zvit").Cells(iLastRow, 1)
                End With
            End Select
        End If
    Next
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
    For Each Sht In Worksheets
        If Sht.Visible Then
            Select Case Sht.Name
            Case "раз", "два", "три"
                With Sht
                    iLR = .Cells(.Rows.Count, 5).End(xlUp).Row
                    iLastRow = Sheets("Zvit").Cells(Sheets("Zvit").Rows.Count, 5).End(xlUp).Row + 1   '+
                    If iLastRow < 5 Then iLastRow = 5
                    .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Sheets("Zvit").Cells(iLastRow, 1)
                End With
            End Select
        End If
    Next
[/vba]

Автор - RAN
Дата добавления - 14.03.2020 в 12:46
Santtic Дата: Суббота, 14.03.2020, 13:04 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
Соберите эти листы в массив

Понял, сейчас и ваш опробую вариант.
RAN, спасибо за помощь.
Скажите пожалуйста, почему макрос выпает в ошибку. когда один из листов пуст. Он копирует только шапку этой таблицы а далее не идет по листам.
К сообщению приложен файл: 7535395.xlsm (212.4 Kb)


Сообщение отредактировал Santtic - Суббота, 14.03.2020, 13:09
 
Ответить
Сообщение
Соберите эти листы в массив

Понял, сейчас и ваш опробую вариант.
RAN, спасибо за помощь.
Скажите пожалуйста, почему макрос выпает в ошибку. когда один из листов пуст. Он копирует только шапку этой таблицы а далее не идет по листам.

Автор - Santtic
Дата добавления - 14.03.2020 в 13:04
Santtic Дата: Суббота, 14.03.2020, 14:21 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
Соберите эти листы в массив

Не могу собрать ваш вариант
 
Ответить
Сообщение
Соберите эти листы в массив

Не могу собрать ваш вариант

Автор - Santtic
Дата добавления - 14.03.2020 в 14:21
Kuzmich Дата: Суббота, 14.03.2020, 14:28 | Сообщение № 10
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Цитата
почему макрос выпает в ошибку. когда один из листов пуст

Добавьте проверку в макрос
[vba]
Код
               With Sht
                    iLR = .Cells(.Rows.Count, 5).End(xlUp).Row
                    If iLR >= 5 Then
                      iLastRow = Sheets("Zvit").Cells(Sheets("Zvit").Rows.Count, 5).End(xlUp).Row + 1   '+
                      If iLastRow < 5 Then iLastRow = 5
                      .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Sheets("Zvit").Cells(iLastRow, 1)
                    End If
                End With
[/vba]
 
Ответить
Сообщение
Цитата
почему макрос выпает в ошибку. когда один из листов пуст

Добавьте проверку в макрос
[vba]
Код
               With Sht
                    iLR = .Cells(.Rows.Count, 5).End(xlUp).Row
                    If iLR >= 5 Then
                      iLastRow = Sheets("Zvit").Cells(Sheets("Zvit").Rows.Count, 5).End(xlUp).Row + 1   '+
                      If iLastRow < 5 Then iLastRow = 5
                      .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Sheets("Zvit").Cells(iLastRow, 1)
                    End If
                End With
[/vba]

Автор - Kuzmich
Дата добавления - 14.03.2020 в 14:28
Santtic Дата: Суббота, 14.03.2020, 15:14 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
Добавьте проверку в макрос

Супер, все заработало, всем благодарен за помощь. Теперь наша единственная женщина сможет легче собирать данные. Спасибо за помощь.
Подскажите, а проверка это
[vba]
Код
If iLR >= 5 Then
[/vba]
 
Ответить
Сообщение
Добавьте проверку в макрос

Супер, все заработало, всем благодарен за помощь. Теперь наша единственная женщина сможет легче собирать данные. Спасибо за помощь.
Подскажите, а проверка это
[vba]
Код
If iLR >= 5 Then
[/vba]

Автор - Santtic
Дата добавления - 14.03.2020 в 15:14
Kuzmich Дата: Суббота, 14.03.2020, 15:21 | Сообщение № 12
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Цитата
Не могу собрать ваш вариант

[vba]
Код
Sub Sbor12()
Dim Sht As Worksheet
Dim iLastRow As Long
Dim iLR As Long
Dim i As Long
Dim ShtName
iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
  If iLastRow < 5 Then iLastRow = 5
Range("A5:Q" & iLastRow).EntireRow.Clear '.Delete 'Clear
ShtName = Array("ПВТР", "Красноградський", "Шебелинське", "Стрійське")
  For i = LBound(ShtName) To UBound(ShtName)
    With Worksheets(ShtName(i))
        If .Visible Then
           iLR = .Cells(.Rows.Count, 5).End(xlUp).Row
             If iLR >= 5 Then
               iLastRow = Sheets("Zvit").Cells(Sheets("Zvit").Rows.Count, 5).End(xlUp).Row + 1   '+
               If iLastRow < 5 Then iLastRow = 5
                 .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Sheets("Zvit").Cells(iLastRow, 1)
               End If
        End If
    End With
  Next
End Sub
[/vba]
 
Ответить
Сообщение
Цитата
Не могу собрать ваш вариант

[vba]
Код
Sub Sbor12()
Dim Sht As Worksheet
Dim iLastRow As Long
Dim iLR As Long
Dim i As Long
Dim ShtName
iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
  If iLastRow < 5 Then iLastRow = 5
Range("A5:Q" & iLastRow).EntireRow.Clear '.Delete 'Clear
ShtName = Array("ПВТР", "Красноградський", "Шебелинське", "Стрійське")
  For i = LBound(ShtName) To UBound(ShtName)
    With Worksheets(ShtName(i))
        If .Visible Then
           iLR = .Cells(.Rows.Count, 5).End(xlUp).Row
             If iLR >= 5 Then
               iLastRow = Sheets("Zvit").Cells(Sheets("Zvit").Rows.Count, 5).End(xlUp).Row + 1   '+
               If iLastRow < 5 Then iLastRow = 5
                 .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Sheets("Zvit").Cells(iLastRow, 1)
               End If
        End If
    End With
  Next
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 14.03.2020 в 15:21
Santtic Дата: Суббота, 14.03.2020, 15:37 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
Спасибо большое, несколько вариантов сбора это всегда хорошо.
Спасибо еще раз.
hands hands hands hands hands hands
 
Ответить
СообщениеСпасибо большое, несколько вариантов сбора это всегда хорошо.
Спасибо еще раз.
hands hands hands hands hands hands

Автор - Santtic
Дата добавления - 14.03.2020 в 15:37
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сбор данных по определенным листам в сводную таблицу (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!