|
そのサンプルデータを見た限りにおいて、ベタ書きでコードを組んでみます。
Sub Test()
Dim MyR As Range
Dim ER As Long
Application.ScreenUpdating = False
Range("G:G").ClearContents
Range("A65536").End(xlUp).EntireRow.ClearContents
With Range("A2", Range("A65536").End(xlUp)).Offset(, 1)
Set MyR = .SpecialCells(2, 1)
.Resize(, 2).SpecialCells(4).FormulaR1C1 = "=R[1]C"
.Resize(, 2).Copy
Range("B2").PasteSpecial xlPasteValues
MyR.EntireRow.Delete xlShiftUp
End With
Set MyR = Nothing
With Range("A65536").End(xlUp).Offset(1)
ER = .Row - 1
.Value = "合計"
.Offset(, 1).Resize(, 5).Formula = "=SUM(B2:B" & ER & ")"
End With
With Range("G1")
.Value = "合計"
.Offset(1).Resize(ER - 1).Formula = "=SUM(B2:F2)"
End With
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
|
|