Прошу помочь создать макрос, удовлетворяющей следующей задаче. Имеем книгу (приложена к сообщению), с листами "Содержание" "Источник" "образец" и 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 на листе "Содержание".
Доброе время суток!
Прошу помочь создать макрос, удовлетворяющей следующей задаче. Имеем книгу (приложена к сообщению), с листами "Содержание" "Источник" "образец" и 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
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]
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]
Manyasha, макрос форматирует всё в диапазоне b9:e32 на всех листах после "образец". Надо наоборот вне диапазона и на листах, в диапазоне календарных дат с ячеек d14 и d15 Листа "Содержание".
И даже не вне диапазона а полностью лист, но с сохранением функций или значений в указанном диапазоне ( в данном случае b9:e32).
Manyasha, макрос форматирует всё в диапазоне b9:e32 на всех листах после "образец". Надо наоборот вне диапазона и на листах, в диапазоне календарных дат с ячеек d14 и d15 Листа "Содержание".
И даже не вне диапазона а полностью лист, но с сохранением функций или значений в указанном диапазоне ( в данном случае b9:e32).Didrou
Сообщение отредактировал Didrou - Пятница, 19.02.2016, 10:54
[/vba] Если нет, нарисуйте в файле на каком-нибудь листе результат, который должен получиться после выполнения макроса. UPD ааа...кажется поняла) сейчас выложу код
Didrou, не очень поняла...стереть все с листа, кроме b9:e32? если да, то в цикле вместо [vba]
[/vba] Если нет, нарисуйте в файле на каком-нибудь листе результат, который должен получиться после выполнения макроса. UPD ааа...кажется поняла) сейчас выложу кодManyasha
ЯД: 410013299366744 WM: R193491431804
Сообщение отредактировал Manyasha - Пятница, 19.02.2016, 10:57
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]
Проверяйте: [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
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 моих кодов.
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
В последнем выложенном мной файле листы с "30.12.2015" по "01.01.2016" отформатированы по образцу. Эти листы скопированы с листа "образец" в чистую, но данные в диапазоне b9:e32 остались прежними/не тронутыми.
Нужно представить как пользователь в ручную копирует лист "образец". Копирует в него содержимое без форматирования с ячеек b9:e32 листа "30.12.2015". Затем удаляет лист "30.12.2015" и переименовывает вновь созданный на "30.12.2015". Вот такой "отформатированный" лист нужен в итоге, но макросом, а не ручками:)
Manyasha, попробую с другой стороны описать.
В последнем выложенном мной файле листы с "30.12.2015" по "01.01.2016" отформатированы по образцу. Эти листы скопированы с листа "образец" в чистую, но данные в диапазоне b9:e32 остались прежними/не тронутыми.
Нужно представить как пользователь в ручную копирует лист "образец". Копирует в него содержимое без форматирования с ячеек b9:e32 листа "30.12.2015". Затем удаляет лист "30.12.2015" и переименовывает вновь созданный на "30.12.2015". Вот такой "отформатированный" лист нужен в итоге, но макросом, а не ручками:)Didrou
Сообщение отредактировал Didrou - Пятница, 19.02.2016, 11:50
Ну не хочу я копировать, переименовывать, удалять... [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] так?
Ну не хочу я копировать, переименовывать, удалять... [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
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]
последняя попытка: [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