Добрый день! Прикладываю файл с примером. Есть макрос, он на лист 1 добавляет данные с листа 2, добавляет шапку и 2 формулы. Но формулы при применении макроса превращают ячейки в значения.
Код |
---|
Dim i As Long, lr As Long, cell As Range, sh2 As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set sh2 = Worksheets("Лист2")
With Worksheets("Лист1")
For i = lr To 2 Step -1
x = Application.WorksheetFunction.CountIf(.Columns(3), .Cells(i, 3))
.Rows(i + 1 & ":" & i + 3).EntireRow.Insert
.Cells(i + 1, 5) = "Факт": .Cells(i + 2, 5) = "План": .Cells(i + 3, 5) = "Разница"
Set cell = sh2.Columns(1).Find(.Cells(i, 3))
sh2.Range(sh2.Cells(cell.Row + 1, 2), _
sh2.Cells(cell.Row + 1, 143)).Copy Destination:=.Cells(i + 2, 6)
For k = 6 To 15
.Cells(i + 1, k).FormulaLocal = Application.WorksheetFunction.CountA(Range(.Cells(i, k), .Cells(i - x + 1, k)))
.Cells(i + 3, k).FormulaLocal = .Cells(i + 1, k) - .Cells(i + 2, k)
Next k
If i - x = 1 Then
.Rows("1:3").EntireRow.Insert
.Cells(3, 5) = "Город": .Cells(2, 5) = "ЗО": .Cells(1, 5) = "Формат"
sh2.Range("B2:EM2").Copy Destination:=.Cells(3, 6)
sh2.Range("B1:EM1").Copy Destination:=.Cells(2, 6)
sh2.Range(sh2.Cells(cell.Row, 2), sh2.Cells(cell.Row, 15)).Copy Destination:=.Cells(1, 6)
Else
.Rows(i - x + 1 & ":" & i - x + 5).EntireRow.Insert
.Rows(1).Copy Destination:=.Rows(i - x + 5)
.Cells(i - x + 4, 5) = "Город": .Cells(i - x + 3, 5) = "ЗО": .Cells(i - x + 2, 5) = "Формат"
sh2.Range("B2:EM2").Copy Destination:=.Cells(i - x + 4, 6)
sh2.Range("B1:EM1").Copy Destination:=.Cells(i - x + 3, 6)
sh2.Range(sh2.Cells(cell.Row, 2), sh2.Cells(cell.Row, 143)).Copy Destination:=.Cells(i - x + 2, 6)
End If
i = i - x + 1
Next i
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub |
В ячейке F11 и вправо до упора, хотелось бы видеть живую формулу =СЧЁТЗ, а в F13 =F11-F12. Можно эти формулы заменить на другие, чтобы формулы в ячейках оставались формулами?
Код |
---|
For k = 6 To 15
.Cells(i + 1, k).FormulaLocal = Application.WorksheetFunction.CountA(Range(.Cells(i, k), .Cells(i - x + 1, k)))
.Cells(i + 3, k).FormulaLocal = .Cells(i + 1, k) - .Cells(i + 2, k)
Next k |