Выборочное форматирование листов по образцу

Дата: Пятница, 19.02.2016, 09:42 | Сообщение № 1

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

Ранг: Новичок

Сообщений: 30

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

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

Excel 2013

Доброе время суток!

Прошу помочь создать макрос, удовлетворяющей следующей задаче. Имеем книгу (приложена к сообщению), с листами "Содержание" "Источник" "образец" и n-ым количеством листов с датами в именах, созданных путем копирования листа "образец".

Задача:
Взять значения из двух ячеек отвечающих за диапазон D14 и D15 на листе "Содержание". Все листы в указанном диапазоне отформатировать согласно листа "образец" со всеми формулами, значениями, цветами и т.д. (один в один), кроме прямоугольного диапазона ячеек, указанного в ячейках D16 и D17.

Я себе эту операцию форматирования представляю так:
1. копирование листа "образец" с временным именем, к примеру "29.12.2015t"
2. занесение туда содержимого ячеек диапазона, указанного в ячейках D16 и D17 листа "Содержание" из форматируемого в данный момент листа "29.12.2015"
3. удаление листа "29.12.2015"
4. переименование листа "29.12.2015t" в "29.12.2015"

и так по каждому листу в диапазоне, указанном в ячейках D14 и D15 на листе "Содержание".

К сообщению приложен файл: 001_v3.xlsm (82.8 Kb)

Сообщение отредактировал Didrou - Пятница, 19.02.2016, 09:45

Дата: Пятница, 19.02.2016, 10:28 | Сообщение № 2

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

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

Сообщений: 2198

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

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

Excel 2010, 2016

Didrou, так нужно (макрос в модуле ReFormat)?
[vba]

Код

Sub Форматировать_по_образцу()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Sheets
        If sh.Name Like "??.??.????" Then
            Sheets("Образец").Range("a1:l34").Copy sh.Range("a1:l34")
            sh.Range("b9:e32").ClearContents
        End If
    Next sh
End Sub

[/vba]
Если в b9:e32 нужно удалить все, включая заливку, то замените строку [vba]

Код

sh.Range("b9:e32").ClearContents

[/vba]
на [vba]

Код

sh.Range("b9:e32").Clear

[/vba]

К сообщению приложен файл: 001_v3-1.xlsm (96.4 Kb)

ЯД: 410013299366744 WM: R193491431804

Дата: Пятница, 19.02.2016, 10:49 | Сообщение № 3

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

Ранг: Новичок

Сообщений: 30

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

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

Excel 2013

Manyasha, макрос форматирует всё в диапазоне b9:e32 на всех листах после "образец". Надо наоборот вне диапазона и на листах, в диапазоне календарных дат с ячеек d14 и d15 Листа "Содержание".

И даже не вне диапазона а полностью лист, но с сохранением функций или значений в указанном диапазоне ( в данном случае b9:e32).

Сообщение отредактировал Didrou - Пятница, 19.02.2016, 10:54

Дата: Пятница, 19.02.2016, 10:56 | Сообщение № 4

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

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

Сообщений: 2198

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

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

Excel 2010, 2016

Didrou, не очень поняла...стереть все с листа, кроме b9:e32?
если да, то в цикле вместо
[vba]

Код

Sheets("Образец").Range("a1:l34").Copy sh.Range("a1:l34")
sh.Range("b9:e32").ClearContents

[/vba]напишите
[vba]

Код

sh.Range("a1:l34").ClearContents
Sheets("Образец").Range("b9:e32").Copy sh.Range("b9:e32")

[/vba]
Если нет, нарисуйте в файле на каком-нибудь листе результат, который должен получиться после выполнения макроса.
UPD
ааа...кажется поняла)
сейчас выложу код

ЯД: 410013299366744 WM: R193491431804

Сообщение отредактировал Manyasha - Пятница, 19.02.2016, 10:57

Дата: Пятница, 19.02.2016, 11:09 | Сообщение № 5

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

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

Сообщений: 2198

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

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

Excel 2010, 2016

Проверяйте:
[vba]

Код

Sub Форматировать_по_образцу()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Sheets
        If sh.Name Like "??.??.????" Then
            With sh
                lr = .UsedRange.Rows.Count
                lc = .UsedRange.Columns.Count
                Union(Range(.Cells(1, 1), .Cells(8, lc)) _
                    , Range(.Cells(9, 6), .Cells(32, lc)) _
                    , Range(.Cells(33, 1), .Cells(lr, lc)) _
                    , Range(.Cells(9, 1), .Cells(lr, 1))).Clear
            End With
        End If
    Next sh
End Sub

[/vba]

К сообщению приложен файл: 001_v3-2.xlsm (98.9 Kb)

ЯД: 410013299366744 WM: R193491431804

Дата: Пятница, 19.02.2016, 11:15 | Сообщение № 6

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

Ранг: Новичок

Сообщений: 30

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

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

Excel 2013

Manyasha, хорошая идея, лучше выложу файл такой, какой нужен в итоге:)

Вот...

К сообщению приложен файл: 001_v3_1__.xlsm (88.1 Kb)

Дата: Пятница, 19.02.2016, 11:18 | Сообщение № 7

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

Ранг: Новичок

Сообщений: 30

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

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

Excel 2013

И даже так, чтобы было нагляднее.

Видите, на листах 30дек 31 дек и 01 янв поменялось форматирование, но остались данные в указанном диапазоне.

К сообщению приложен файл: 001_v3_1____.xlsm (90.1 Kb)

Дата: Пятница, 19.02.2016, 11:32 | Сообщение № 8

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

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

Сообщений: 2198

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

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

Excel 2010, 2016

Didrou, все равно не понятно

Т.е. нужно скопировать только формат, да?
на весь лист?
Тогда причем тут диапазон "b9:e32"? Он у Вас ничем (в плане формата) не отличается от образца.
И значения вне диапазона "b9:e32" тоже остаются без изменений...
Скопировать формат можно так...
[vba]

Код

        If sh.Name Like "??.??.????" Then
            Sheets("Образец").Range("a1:l34").Copy
            sh.Range("a1:l34").PasteSpecial xlPasteFormats
        End If

[/vba]
Если опять не угадала с диапазонами, используйте задание правильных диапазонов из предыдущих 2 моих кодов.

ЯД: 410013299366744 WM: R193491431804

Дата: Пятница, 19.02.2016, 11:48 | Сообщение № 9

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

Ранг: Новичок

Сообщений: 30

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

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

Excel 2013

Manyasha, попробую с другой стороны описать.

В последнем выложенном мной файле листы с "30.12.2015" по "01.01.2016" отформатированы по образцу.
Эти листы скопированы с листа "образец" в чистую, но данные в диапазоне b9:e32 остались прежними/не тронутыми.

Нужно представить как пользователь в ручную копирует лист "образец". Копирует в него содержимое без форматирования с ячеек b9:e32 листа "30.12.2015". Затем удаляет лист "30.12.2015" и переименовывает вновь созданный на "30.12.2015". Вот такой "отформатированный" лист нужен в итоге, но макросом, а не ручками:)

Сообщение отредактировал Didrou - Пятница, 19.02.2016, 11:50

Дата: Пятница, 19.02.2016, 12:03 | Сообщение № 10

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

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

Сообщений: 2198

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

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

Excel 2010, 2016

Ну не хочу я копировать, переименовывать, удалять...

[vba]

Код

Sub Форматировать_по_образцу()
    Application.ScreenUpdating = False
    Dim sh As Worksheet, sh1 As Worksheet
    Set sh1 = Sheets("Образец")
    lr = sh1.UsedRange.Rows.Count
    lc = sh1.UsedRange.Columns.Count
    For Each sh In ThisWorkbook.Sheets
        If sh.Name Like "??.??.????" Then
            With sh
                Range(sh1.Cells(1, 1), sh1.Cells(8, lc)).Copy Range(.Cells(1, 1), .Cells(8, lc))
                Range(sh1.Cells(9, 6), sh1.Cells(32, lc)).Copy Range(.Cells(9, 6), .Cells(32, lc))
                Range(sh1.Cells(33, 1), sh1.Cells(lr, lc)).Copy Range(.Cells(33, 1), .Cells(lr, lc))
                Range(sh1.Cells(9, 1), sh1.Cells(lr, 1)).Copy Range(.Cells(9, 1), .Cells(lr, 1))
                sh1.Range("b9:e32").Copy
                .Range("b9:e32").PasteSpecial xlPasteFormats
            End With
        End If
    Next sh
    Application.ScreenUpdating = True
End Sub

[/vba]
так?

ЯД: 410013299366744 WM: R193491431804

Дата: Пятница, 19.02.2016, 13:44 | Сообщение № 11

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

Ранг: Новичок

Сообщений: 30

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

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

Excel 2013

Manyasha, в части форматирования вроде все в порядке.
Осталось применять не по условию:

[vba]

Код

If sh.Name Like "??.??.????" Then

[/vba]

а только к указанным листам, как в условиях задачи. И чтобы диапазон ячеек указывался не прямо в макросе

[vba]

Код

sh1.Range("b9:e32").Copy
.Range("b9:e32").PasteSpecial xlPasteFormats

[/vba]

а брался из ячеек D16 и D17 листа "Содержание".

Дата: Пятница, 19.02.2016, 15:15 | Сообщение № 12

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

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

Сообщений: 2198

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

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

Excel 2010, 2016

последняя попытка:
[vba]

Код

Sub Форматировать_по_образцу()
    Application.ScreenUpdating = False
    Dim sh As Worksheet, sh1 As Worksheet
    Set sh1 = Sheets("Образец")
    lr = sh1.UsedRange.Rows.Count
    lc = sh1.UsedRange.Columns.Count
    With Sheets("Содержание")
        r = Range(.Cells(Range(.[d16]).Row, Range(.[d16]).Column), .Cells(Range(.[d17]).Row, Range(.[d17]).Column)).Address
    End With
    For Each sh In ThisWorkbook.Sheets
    If sh.Name Like "??.??.????" Then
        If CDate(sh.Name) >= Sheets("Содержание").Range("d9") And CDate(sh.Name) <= Sheets("Содержание").Range("d10") Then
            'Если нужны только значения, уберите Formula
            Rng = sh.Range(r).Formula
            Sheets("Образец").Range("a1:l34").Copy sh.Range("a1:l34")
            sh.Range(r).Formula = Rng
        End If
    End If
    Next sh
    Application.ScreenUpdating = True
End Sub

[/vba]

ЯД: 410013299366744 WM: R193491431804

Дата: Пятница, 19.02.2016, 16:32 | Сообщение № 13

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

Ранг: Новичок

Сообщений: 30

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

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

Excel 2013

Manyasha, всё работает, только не тот диапазон брался
[vba]

Код

If CDate(sh.Name) >= Sheets("Содержание").Range("d9") And CDate(sh.Name) <= Sheets("Содержание").Range("d10")

[/vba]
не d9 и d10, а d14 и d15, но это сущие пустяки, спасибо тебе!