|
商品は14まで必ずあるとして
Sub try2()
Dim r As Range, rr As Range
Set rr = Worksheets("Sheet2").Range("A1")
Application.ScreenUpdating = False
With Worksheets("Sheet1")
' Sheet1のA2〜A列最終行までをループ
For Each r In .Range(.Range("A2"), .Cells(Rows.Count, 1).End(xlUp))
' IDと名前を転記
r.Resize(, 2).Copy rr
' 商品名1〜商品名14の項目を転記
.Range("C1,E1,G1,I1,K1,M1,O1,Q1,S1,U1,W1,Y1,AA1,AC1").Copy rr.Offset(1)
' ID毎の各商品個数(?)を転記
r.Range("C1,E1,G1,I1,K1,M1,O1,Q1,S1,U1,W1,Y1,AA1,AC1").Copy rr.Offset(2)
' ID毎の各商品金額を転記
r.Range("D1,F1,H1,J1,L1,N1,P1,R1,T1,V1,X1,Z1,AB1,AD1").Copy rr.Offset(3)
' 項目名”合計”を代入
rr.Offset(1, 14).Value = "合計"
' ID毎の金額の合計を”合計”の列に代入
rr.Offset(3, 14).Value = Application.Sum(rr.Offset(3).Resize(, 14))
' Sheet2のA列の行数を4行ずらす
Set rr = rr.Offset(4)
Next
End With
Application.ScreenUpdating = True
Set rr = Nothing
End Sub
こちらの方がわかりやすいでしょうか?
|
|