Доброго времени форумчане! Данную тему открывал ранее: http://www.excelworld.ru/forum/10-31195-1 , задача была решена спасибо nilem! Но, позже я понял, что проблема решена не полностью, а именно при копировании ячеек в право функция даёт область (=B1:E1), а должна =B1 и ещё есть проблема в том, что при пустой ячейке код выдаёт ошибку, то есть в идеале работа макроса: при выделении определённой области группы ячеек, группа это объединённые ячейки с функцией (состав 8 шт.).
Доброго времени форумчане! Данную тему открывал ранее: http://www.excelworld.ru/forum/10-31195-1 , задача была решена спасибо nilem! Но, позже я понял, что проблема решена не полностью, а именно при копировании ячеек в право функция даёт область (=B1:E1), а должна =B1 и ещё есть проблема в том, что при пустой ячейке код выдаёт ошибку, то есть в идеале работа макроса: при выделении определённой области группы ячеек, группа это объединённые ячейки с функцией (состав 8 шт.).adamm1603
Только вставленные формулы ссылаются не на первую ячейку в объединенной группе, а на соседнюю верхнюю. В прежней версии макроса так же было. Просто так не получается сделать, чтобы все ячейки ссылались на первую ячейку объединенной группы, нужно усложнять макрос. [vba]
Код
Sub Подставить_формулы()
Dim cl As New Collection, rng As Range Dim i As Long, j As Long
Application.ScreenUpdating = False
For i = 1 To Selection.Rows.Count Step 8 For j = 1 To Selection.Columns.Count cl.Add Item:=Selection.Cells(i, j).MergeArea.Address Next j Next i
Selection.UnMerge
For i = 1 To cl.Count Set rng = Range(cl(i)) rng.Rows("2:8").Formula = "=" & rng.Cells(1, 1).Address(False, False) Range("A1:A8").Copy rng.PasteSpecial Paste:=xlPasteFormats Next i Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
[/vba]
Только вставленные формулы ссылаются не на первую ячейку в объединенной группе, а на соседнюю верхнюю. В прежней версии макроса так же было. Просто так не получается сделать, чтобы все ячейки ссылались на первую ячейку объединенной группы, нужно усложнять макрос. [vba]
Код
Sub Подставить_формулы()
Dim cl As New Collection, rng As Range Dim i As Long, j As Long
Application.ScreenUpdating = False
For i = 1 To Selection.Rows.Count Step 8 For j = 1 To Selection.Columns.Count cl.Add Item:=Selection.Cells(i, j).MergeArea.Address Next j Next i
Selection.UnMerge
For i = 1 To cl.Count Set rng = Range(cl(i)) rng.Rows("2:8").Formula = "=" & rng.Cells(1, 1).Address(False, False) Range("A1:A8").Copy rng.PasteSpecial Paste:=xlPasteFormats Next i Application.CutCopyMode = False
копирует формат ячеек A1:F8 и переносит в нужные, а возможно это сделать сразу в одном макросе, я пробовал заменить строчки Вашего кода тем, макросом, что объединяет ячейки, но не получается
Karataev на этот раз всё работает, как понимаю данный код
копирует формат ячеек A1:F8 и переносит в нужные, а возможно это сделать сразу в одном макросе, я пробовал заменить строчки Вашего кода тем, макросом, что объединяет ячейки, но не получаетсяadamm1603