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

Вход

Регистрация

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

 

= Мир MS Excel/Выборочное форматирование листов по образцу - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выборочное форматирование листов по образцу (Макросы/Sub)
Выборочное форматирование листов по образцу
Didrou Дата: Пятница, 19.02.2016, 09:42 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 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(83Kb)


Сообщение отредактировал Didrou - Пятница, 19.02.2016, 09:45
 
Ответить
СообщениеДоброе время суток!

Прошу помочь создать макрос, удовлетворяющей следующей задаче. Имеем книгу (приложена к сообщению), с листами "Содержание" "Источник" "образец" и 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 на листе "Содержание".

Автор - Didrou
Дата добавления - 19.02.2016 в 09:42
Manyasha Дата: Пятница, 19.02.2016, 10:28 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 1589
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
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(96Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение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]

Автор - Manyasha
Дата добавления - 19.02.2016 в 10:28
Didrou Дата: Пятница, 19.02.2016, 10:49 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 0 ±
Замечаний: 0% ±

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

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


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

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

Автор - Didrou
Дата добавления - 19.02.2016 в 10:49
Manyasha Дата: Пятница, 19.02.2016, 10:56 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 1589
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
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
ааа...кажется поняла)
сейчас выложу код


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804


Сообщение отредактировал Manyasha - Пятница, 19.02.2016, 10:57
 
Ответить
Сообщение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
ааа...кажется поняла)
сейчас выложу код

Автор - Manyasha
Дата добавления - 19.02.2016 в 10:56
Manyasha Дата: Пятница, 19.02.2016, 11:09 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 1589
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
Проверяйте:
[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(99Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеПроверяйте:
[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]

Автор - Manyasha
Дата добавления - 19.02.2016 в 11:09
Didrou Дата: Пятница, 19.02.2016, 11:15 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 0 ±
Замечаний: 0% ±

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

Вот...
К сообщению приложен файл: 001_v3_1__.xlsm(88Kb)
 
Ответить
СообщениеManyasha, хорошая идея, лучше выложу файл такой, какой нужен в итоге:)

Вот...

Автор - Didrou
Дата добавления - 19.02.2016 в 11:15
Didrou Дата: Пятница, 19.02.2016, 11:18 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 0 ±
Замечаний: 0% ±

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

Видите, на листах 30дек 31 дек и 01 янв поменялось форматирование, но остались данные в указанном диапазоне.
К сообщению приложен файл: 001_v3_1____.xlsm(90Kb)
 
Ответить
СообщениеИ даже так, чтобы было нагляднее.

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

Автор - Didrou
Дата добавления - 19.02.2016 в 11:18
Manyasha Дата: Пятница, 19.02.2016, 11:32 | Сообщение № 8
Группа: Модераторы
Ранг: Старожил
Сообщений: 1589
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
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 моих кодов.


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение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 моих кодов.

Автор - Manyasha
Дата добавления - 19.02.2016 в 11:32
Didrou Дата: Пятница, 19.02.2016, 11:48 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 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
 
Ответить
Сообщение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:48
Manyasha Дата: Пятница, 19.02.2016, 12:03 | Сообщение № 10
Группа: Модераторы
Ранг: Старожил
Сообщений: 1589
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
Ну не хочу я копировать, переименовывать, удалять... :p
[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]
так?


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеНу не хочу я копировать, переименовывать, удалять... :p
[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]
так?

Автор - Manyasha
Дата добавления - 19.02.2016 в 12:03
Didrou Дата: Пятница, 19.02.2016, 13:44 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 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 листа "Содержание".
 
Ответить
СообщениеManyasha, в части форматирования вроде все в порядке.
Осталось применять не по условию:

[vba]
Код

If sh.Name Like "??.??.????" Then
[/vba]

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

[vba]
Код

sh1.Range("b9:e32").Copy
.Range("b9:e32").PasteSpecial xlPasteFormats
[/vba]

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

Автор - Didrou
Дата добавления - 19.02.2016 в 13:44
Manyasha Дата: Пятница, 19.02.2016, 15:15 | Сообщение № 12
Группа: Модераторы
Ранг: Старожил
Сообщений: 1589
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
последняя попытка:
[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]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениепоследняя попытка:
[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]

Автор - Manyasha
Дата добавления - 19.02.2016 в 15:15
Didrou Дата: Пятница, 19.02.2016, 16:32 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 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, но это сущие пустяки, спасибо тебе! :)
 
Ответить
СообщениеManyasha, всё работает, только не тот диапазон брался
[vba]
Код

If CDate(sh.Name) >= Sheets("Содержание").Range("d9") And CDate(sh.Name) <= Sheets("Содержание").Range("d10")
[/vba]
не d9 и d10, а d14 и d15, но это сущие пустяки, спасибо тебе! :)

Автор - Didrou
Дата добавления - 19.02.2016 в 16:32
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выборочное форматирование листов по образцу (Макросы/Sub)
Страница 1 из 11
Поиск:

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