Соединение листов в один с разделением и подписью исх. листа

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Соединение листов в один с разделением и подписью исх. листа (Макросы/Sub)

Metrica

Дата: Четверг, 12.11.2015, 00:07 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Добрый день. Подскажите пожалуйста.
Есть макрос.
[vba]

Код

Sub Svod_grup()
Application.ScreenUpdating = False

Dim sch_vert, stroka As Variant
Dim ii As Integer
Sheets("svod").Select
Rows("2:65000").Select
Selection.Delete Shift:=xlUp
stroka = 2
For ii = 1 To Sheets.Count
Sheets(ii).Select
If Sheets(ii).Name <> "svod" Then
sch_vert = Cells(1, 1).End(xlDown).Row - 1
Rows("2:" + Trim(Str(sch_vert + 1))).Select
Selection.Copy

Sheets("svod").Select
Rows(Trim(Str(stroka)) + ":" + Trim(Str(stroka))).Select
ActiveSheet.Paste

stroka = stroka + sch_vert
End If
Next 'ii
Application.CutCopyMode = False

Application.ScreenUpdating = True
End Sub

[/vba]

Макрос собирает все листы в один, ставя один за другим.
Не могу решить несколько проблем.
1. В конце добавляет повтор - 1 строку с первого листа.
2. Подскажите как вставить разделитель 2 пустые строки между строками с разных листов.
3. Как в ячейке напротив строки вставить название листа с которой она перенесена. Возле первой строки с листа или напротив каждой не важно.
4. Есть листы удаленка, удаленка 1... удаленка n. С них данные не нужны. Я предварительно удаляю их в ручную. Можно это прописать в макрос?
Зарание спасибо. :)
[moder]Для макроса есть специальная кнопка - #. Поправил Вам.

К сообщению приложен файл: 8773747.xlsx (24.9 Kb)

Сообщение отредактировал _Boroda_ - Четверг, 12.11.2015, 00:40

Ответить

_Boroda_

Дата: Четверг, 12.11.2015, 01:18 | Сообщение № 2

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Не путая Вас пока массивами и коллекциями, вот такой простенький вариант
[vba]

Код

Sub Svod_grup()
    Application.ScreenUpdating = 0
    cal_ = Application.Calculation
    Application.Calculation = xlCalculationManual
    With Sheets("svod")
        Range(.Range("A2"), .Range("A2").SpecialCells(xlLastCell)).ClearContents
    End With
    For i = 1 To Sheets.Count
        sn_ = Sheets(i).Name
        If sn_ <> "SVOD" Then
            If Not LCase(sn_) Like "удаленка*" Then
                r1_ = WorksheetFunction.Max(2, Sheets("SVOD").Range("A" & Rows.Count).End(xlUp).Row)
                If r1_ > 2 Then r1_ = r1_ + 3
                r11_ = Sheets(i).Range("A" & Rows.Count).End(xlUp).Row
                With Sheets("SVOD").Range("A" & r1_).Resize(r11_ - 1)
                    .Value = Sheets(i).Name
                    .Offset(, 1).Value = Sheets(i).Range("A2").Resize(r11_ - 1).Value
                End With
            End If
        End If
    Next i
    Application.Calculation = cal_
    Application.ScreenUpdating = 1
End Sub

[/vba]

К сообщению приложен файл: 8773747_1.xlsm (41.6 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

SLAVICK

Дата: Четверг, 12.11.2015, 10:57 | Сообщение № 3

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Когда себе делал макрос сбора листов - заметил одну очень странную особенность:
[vba]

Код

Range1.Value = Range.Value

[/vba]
Работает быстрее на небольших диапазонах
Если данных много - гораздо быстрее работает :
[vba]

Код

Range.copy
Range1.PasteSpecial xlPasteValues

[/vba]

Вот можно протестировать на примере, добавил таймеры.
я сделал копирование не только 1-го столбца, а с А по АD(30-ть столбцов):
[vba]

Код

Sub Svod_grup_1()
    Application.ScreenUpdating = 0
    t = Timer
    cal_ = Application.Calculation
    Application.Calculation = xlCalculationManual
    With Sheets("svod")
        Range(.Range("A2"), .Range("A2").SpecialCells(xlLastCell)).ClearContents
    End With
    For i = 1 To Sheets.Count
        sn_ = Sheets(i).Name
        If sn_ <> "SVOD" Then
            If Not LCase(sn_) Like "удаленка*" Then
                r1_ = WorksheetFunction.Max(2, Sheets("SVOD").Range("A" & Rows.Count).End(xlUp).Row)
                If r1_ > 2 Then r1_ = r1_ + 3
                r11_ = Sheets(i).Range("A" & Rows.Count).End(xlUp).Row
                Sheets(i).Range("A2:ad" & r11_).Copy
                Sheets("SVOD").Range("b" & r1_).PasteSpecial xlPasteValues
                Sheets("SVOD").Range("A" & r1_ & ":a" & r11_ + r1_ - 2) = Sheets(i).Name
            End If
        End If
    Next i
    Application.Calculation = cal_
    Application.ScreenUpdating = 1
    MsgBox Format(Timer - t, "0.00")
End Sub

[/vba]

К сообщению приложен файл: 8773747_1.zip (64.8 Kb)

Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK - Четверг, 12.11.2015, 11:02

Ответить

Metrica

Дата: Четверг, 12.11.2015, 12:19 | Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

_Boroda_,
Взяла Ваш вариант.
Применила на книге где больше 100 листов и 2500 строк. Быстро и корректно сгруппировало. Раньше тратила больше 2 часов на группировку.
Спасибо !!

Я еще чайник в макросах, месяц мучилась.

Если кто будет брать макрос, я вот не знала: лист Svod и SVOD для макроса вещи разные. Если прописать маленькими буквами, то он группирует и этот лист в конце.

SLAVICK, спасибо и Вам.
Таймер мне только мешает, а в ексельке прикрепленой еще какието числа лезут... до конца не поняла. Вариант _Boroda_ проще и понятней.

Ответить

SLAVICK

Дата: Четверг, 12.11.2015, 12:37 | Сообщение № 5

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Цитата Metrica, 12.11.2015 в 12:19, в сообщении № 4

Таймер мне только мешает,

Таймер можно удалить - удалите строки:
[vba]

Код

t = Timer
и
MsgBox Format(Timer - t, "0.00")

[/vba]
Это я для сравнения добавил. Просто я работаю с бОльшим количеством данных - вот написал, возможно кому -то будет полезно.
Разница существенна, особенно когда строк несколько десятков тысяч и столбцов свыше 50

Цитата Metrica, 12.11.2015 в 12:19, в сообщении № 4

а в ексельке прикрепленой еще какието числа лезут... до конца не поняла. Вариант _Boroda_ проще и понятней.

числа - это я специально добавил на собираемые листы - посмотрите - это просто чтобы было больше данных. Так заметнее разница в быстродействии. ;)
А у Вас на всех листах данные только в 1-м столбце, или только в примере?

Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK - Четверг, 12.11.2015, 12:39

Ответить

Metrica

Дата: Воскресенье, 22.11.2015, 13:34 | Сообщение № 6

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Цитата SLAVICK, 12.11.2015 в 12:37, в сообщении № 5

А у Вас на всех листах данные только в 1-м столбце, или только в примере?

Да, один столбец до 1000 строк и листов от 100

Ответить

Страница 1 из 1
1