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

Вход

Регистрация

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

 

= Мир MS Excel/Консолидация листов книги в один - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Консолидация листов книги в один (Макросы/Sub)
Консолидация листов книги в один
w00t Дата: Пятница, 01.07.2016, 22:16 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 126
Репутация: 3 ±
Замечаний: 0% ±

Пример реальной книги во вложении. В реальной - больше строк и 15-20 листов для объединения на один. Структура тестовой таблицы в точности повторяет реальную.

Нужно объединить таблицы со всех листов (за исключением листов "Тест" и "Данные") на лист "Svod" в одну таблицу, но только нужные столбцы.
Полезные данные в листах для объединения начинаются с ячейки A9. Вниз с А9 и вправо - это и есть табличка, которую нужно поместить на лист Svod. Только не всю, а выделенные оранжевым столбцы.

То есть, перенести нужные столбцы одного листа на свод и указать имя листа откуда взято, затем посмотреть второй лист и так далее. И исключить из консолидации два листа "Тест" и "Данные".

На листе "Svod" есть кнопочка с макросом, он объединяет таблички, в случае, если выше полезных данных нет мусора, а без него никак. В моем случае прошу помочь с табличками.
К сообщению приложен файл: Test.xlsb(26Kb)
 
Ответить
СообщениеПример реальной книги во вложении. В реальной - больше строк и 15-20 листов для объединения на один. Структура тестовой таблицы в точности повторяет реальную.

Нужно объединить таблицы со всех листов (за исключением листов "Тест" и "Данные") на лист "Svod" в одну таблицу, но только нужные столбцы.
Полезные данные в листах для объединения начинаются с ячейки A9. Вниз с А9 и вправо - это и есть табличка, которую нужно поместить на лист Svod. Только не всю, а выделенные оранжевым столбцы.

То есть, перенести нужные столбцы одного листа на свод и указать имя листа откуда взято, затем посмотреть второй лист и так далее. И исключить из консолидации два листа "Тест" и "Данные".

На листе "Svod" есть кнопочка с макросом, он объединяет таблички, в случае, если выше полезных данных нет мусора, а без него никак. В моем случае прошу помочь с табличками.

Автор - w00t
Дата добавления - 01.07.2016 в 22:16
SLAVICK Дата: Пятница, 01.07.2016, 23:15 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 1849
Репутация: 614 ±
Замечаний: 0% ±

2007,2010,2013,2016
ну если не сильно изменять Ваш код то так:
[vba]
Код
Sub www()
    Dim ws As Worksheet, l&
    With Sheets("Svod")
        .UsedRange.Offset(1).ClearContents
        For Each ws In Worksheets
            If Not ws.Name = "Svod" And Not ws.Name = "Данные" And Not ws.Name = "Тест" Then
            On Error Resume Next
                l = .Cells.Find("*", [a1], xlFormulas, 1, 1, 2).Row + 1
                If l < 1 Then l = 1

                'Intersect(ws.UsedRange.Offset(7), ws.Range("a:a,e:e,m:m,p:p")).Copy .Range("a" & l)'в Offset(7) - нужно указать с какой строки собирать -2
                Intersect(Range(ws.Cells(9, "a"), ws.Cells.Find("*", ws.[a1], xlFormulas, 1, 1, 2)), ws.Range("a:a,e:e,m:m,p:p")).Copy .Range("a" & l) 'но лучше так
            End If
        Next
    End With
End Sub
[/vba]
К сообщению приложен файл: 5149455.xlsb(26Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщениену если не сильно изменять Ваш код то так:
[vba]
Код
Sub www()
    Dim ws As Worksheet, l&
    With Sheets("Svod")
        .UsedRange.Offset(1).ClearContents
        For Each ws In Worksheets
            If Not ws.Name = "Svod" And Not ws.Name = "Данные" And Not ws.Name = "Тест" Then
            On Error Resume Next
                l = .Cells.Find("*", [a1], xlFormulas, 1, 1, 2).Row + 1
                If l < 1 Then l = 1

                'Intersect(ws.UsedRange.Offset(7), ws.Range("a:a,e:e,m:m,p:p")).Copy .Range("a" & l)'в Offset(7) - нужно указать с какой строки собирать -2
                Intersect(Range(ws.Cells(9, "a"), ws.Cells.Find("*", ws.[a1], xlFormulas, 1, 1, 2)), ws.Range("a:a,e:e,m:m,p:p")).Copy .Range("a" & l) 'но лучше так
            End If
        Next
    End With
End Sub
[/vba]

Автор - SLAVICK
Дата добавления - 01.07.2016 в 23:15
w00t Дата: Пятница, 01.07.2016, 23:25 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 126
Репутация: 3 ±
Замечаний: 0% ±

Так, спасибо.

Поменял строку, с 9 на 10: [vba]
Код
Intersect(Range(ws.Cells(10, "a")
[/vba]

+ заранее на листе Svod оставил первую строку с заголовками. Потому что на листе свод нужна лишь одна строка заголовков, а под нее выдернуть все данные без заголовков их нужных столбцов всех листов.

Только как оптимально прописать в коде, чтобы в столбец E на листе Svod вставлялось имя листа, из которого скопированы данные?
К сообщению приложен файл: 5236546.xlsb(27Kb)


Сообщение отредактировал w00t - Пятница, 01.07.2016, 23:28
 
Ответить
СообщениеТак, спасибо.

Поменял строку, с 9 на 10: [vba]
Код
Intersect(Range(ws.Cells(10, "a")
[/vba]

+ заранее на листе Svod оставил первую строку с заголовками. Потому что на листе свод нужна лишь одна строка заголовков, а под нее выдернуть все данные без заголовков их нужных столбцов всех листов.

Только как оптимально прописать в коде, чтобы в столбец E на листе Svod вставлялось имя листа, из которого скопированы данные?

Автор - w00t
Дата добавления - 01.07.2016 в 23:25
nilem Дата: Пятница, 01.07.2016, 23:30 | Сообщение № 4
Группа: Авторы
Ранг: Ветеран
Сообщений: 1057
Репутация: 400 ±
Замечаний: 0% ±

Excel 2013
можно так попробовать:
[vba]
Код
Sub ertert()
Dim wsh As Worksheet, i&
Sheets("Svod").UsedRange.Offset(1).ClearContents
For Each wsh In Worksheets
    Select Case wsh.Name
        Case "Svod", "Тест", "Данные"
        Case Else
            With wsh.Range("A10:P" & wsh.Cells(Rows.Count, 1).End(xlUp).Row)
                i = Sheets("Svod").Cells(Rows.Count, 1).End(xlUp)(2, 1).Row
                Union(.Columns(1), .Columns(5), .Columns(13), .Columns(16)).Copy Sheets("Svod").Cells(i, 1)
                Sheets("Svod").Cells(i, 5).Resize(.Rows.Count).Value = wsh.Name
            End With
    End Select
Next
End Sub
[/vba]

не увидел, что ответ уже есть. Но все равно попробовать можно :)


Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Пятница, 01.07.2016, 23:31
 
Ответить
Сообщениеможно так попробовать:
[vba]
Код
Sub ertert()
Dim wsh As Worksheet, i&
Sheets("Svod").UsedRange.Offset(1).ClearContents
For Each wsh In Worksheets
    Select Case wsh.Name
        Case "Svod", "Тест", "Данные"
        Case Else
            With wsh.Range("A10:P" & wsh.Cells(Rows.Count, 1).End(xlUp).Row)
                i = Sheets("Svod").Cells(Rows.Count, 1).End(xlUp)(2, 1).Row
                Union(.Columns(1), .Columns(5), .Columns(13), .Columns(16)).Copy Sheets("Svod").Cells(i, 1)
                Sheets("Svod").Cells(i, 5).Resize(.Rows.Count).Value = wsh.Name
            End With
    End Select
Next
End Sub
[/vba]

не увидел, что ответ уже есть. Но все равно попробовать можно :)

Автор - nilem
Дата добавления - 01.07.2016 в 23:30
SLAVICK Дата: Пятница, 01.07.2016, 23:53 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 1849
Репутация: 614 ±
Замечаний: 0% ±

2007,2010,2013,2016
чтобы в столбец E на листе Svod вставлялось имя листа,

а я и хотел еще спросить про имя листа - но думаю раз не просют то и не надо :D
добавить одну строку:
[vba]
Код
Range("e" & l & ":e" & .Cells.Find("*", [a1], xlFormulas, 1, 1, 2).Row) = ws.Name
[/vba]
т.е все вместе:
[vba]
Код
Sub www()
    Dim ws As Worksheet, l&
    With Sheets("Svod")
        .UsedRange.Offset(1).ClearContents
        For Each ws In Worksheets
            If Not ws.Name = "Svod" And Not ws.Name = "Данные" And Not ws.Name = "Тест" Then
            On Error Resume Next
                l = .Cells.Find("*", [a1], xlFormulas, 1, 1, 2).Row + 1
                If l < 1 Then l = 1
                Intersect(Range(ws.Cells(10, "a"), ws.Cells.Find("*", ws.[a1], xlFormulas, 1, 1, 2)), ws.Range("a:a,e:e,m:m,p:p")).Copy .Range("a" & l) 'но лучше так
                Range("e" & l & ":e" & .Cells.Find("*", [a1], xlFormulas, 1, 1, 2).Row) = ws.Name
            End If
        Next
    End With
End Sub
[/vba]
К сообщению приложен файл: 6259854.xlsb(26Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
чтобы в столбец E на листе Svod вставлялось имя листа,

а я и хотел еще спросить про имя листа - но думаю раз не просют то и не надо :D
добавить одну строку:
[vba]
Код
Range("e" & l & ":e" & .Cells.Find("*", [a1], xlFormulas, 1, 1, 2).Row) = ws.Name
[/vba]
т.е все вместе:
[vba]
Код
Sub www()
    Dim ws As Worksheet, l&
    With Sheets("Svod")
        .UsedRange.Offset(1).ClearContents
        For Each ws In Worksheets
            If Not ws.Name = "Svod" And Not ws.Name = "Данные" And Not ws.Name = "Тест" Then
            On Error Resume Next
                l = .Cells.Find("*", [a1], xlFormulas, 1, 1, 2).Row + 1
                If l < 1 Then l = 1
                Intersect(Range(ws.Cells(10, "a"), ws.Cells.Find("*", ws.[a1], xlFormulas, 1, 1, 2)), ws.Range("a:a,e:e,m:m,p:p")).Copy .Range("a" & l) 'но лучше так
                Range("e" & l & ":e" & .Cells.Find("*", [a1], xlFormulas, 1, 1, 2).Row) = ws.Name
            End If
        Next
    End With
End Sub
[/vba]

Автор - SLAVICK
Дата добавления - 01.07.2016 в 23:53
w00t Дата: Суббота, 02.07.2016, 01:44 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 126
Репутация: 3 ±
Замечаний: 0% ±

не увидел, что ответ уже есть. Но все равно попробовать можно

Все так, спасибо :)

Но у меня интерес просто, чтобы понять эту часть кода
[vba]
Код
'Intersect(ws.UsedRange.Offset(7), ws.Range("a:a,e:e,m:m,p:p")).Copy .Range("a" & l)'в Offset(7) - нужно указать с какой строки собирать -2
Intersect(Range(ws.Cells(9, "a"), ws.Cells.Find("*", ws.[a1], xlFormulas, 1, 1, 2)), ws.Range("a:a,e:e,m:m,p:p")).Copy .Range("a" & l) 'но лучше так
[/vba]
которая закомментирована - работает как надо, только Offset(8). Которая наоборот, активна - не совсем. Поясню суть: столбик непрерывный только в a10 и далее, прочие могут быть любыми. Например, если очистить из последнего сообщения с файлом всего лишь одну строчку на Листе 1, в ячейке P21. То на листе Svod все, кроме первого столбика - будет пустым.

PS: исходный утянут отсюда


Сообщение отредактировал w00t - Суббота, 02.07.2016, 01:51
 
Ответить
Сообщение
не увидел, что ответ уже есть. Но все равно попробовать можно

Все так, спасибо :)

Но у меня интерес просто, чтобы понять эту часть кода
[vba]
Код
'Intersect(ws.UsedRange.Offset(7), ws.Range("a:a,e:e,m:m,p:p")).Copy .Range("a" & l)'в Offset(7) - нужно указать с какой строки собирать -2
Intersect(Range(ws.Cells(9, "a"), ws.Cells.Find("*", ws.[a1], xlFormulas, 1, 1, 2)), ws.Range("a:a,e:e,m:m,p:p")).Copy .Range("a" & l) 'но лучше так
[/vba]
которая закомментирована - работает как надо, только Offset(8). Которая наоборот, активна - не совсем. Поясню суть: столбик непрерывный только в a10 и далее, прочие могут быть любыми. Например, если очистить из последнего сообщения с файлом всего лишь одну строчку на Листе 1, в ячейке P21. То на листе Svod все, кроме первого столбика - будет пустым.

PS: исходный утянут отсюда

Автор - w00t
Дата добавления - 02.07.2016 в 01:44
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Консолидация листов книги в один (Макросы/Sub)
Страница 1 из 11
Поиск:

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