|
元の表があります。これを仕上げの表のようにしたいのです。
元の表 項目1 項目2 項目3 項目4 項目5
101 AAA 500 300 200 500
102 BBB 400 100 50 400
104 DDD 600 0 250 600
105 EEE 150 50 0 150
107 FFF 600 0 0 600
109 HHH 180 80 50 180
仕上げ表 項目1 項目2 項目3 項目4 項目5
101 AAA 500 300 200 500
102 BBB 400 100 50 400
103 PPP 0 0 0 0
104 DDD 600 0 250 600
105 EEE 150 50 0 150
107 FFF 600 0 0 600
108 GGG 0 0 0 0
109 HHH 180 80 50 180
何とかマクロで処理したくコードを書きましたが、もっとシンプルに
書く方法は無いでしょうか。このサンプル以上に挿入行が増えるものですから
シンプルにしないとコードが長くなりすぎ、分かりにくくなるのでは?っと思い
質問させていただきます。
一回目の質問はわかりづらく失礼しました。
Sub 表の補完()
Dim i As Integer
For i = 5 To Cells(65536, 2).End(xlUp).Row
If Cells(i, 1) = "102" Then
Cells(i, 1).Offset(1).Select
Range(Selection, Selection.Offset(, 5)).Select
Selection.Insert shift:=xlDown
ActiveCell.Offset(, 1).Value = "PPP"
ActiveCell.Offset(, 2).Value = "0"
ActiveCell.Offset(, 3).Value = "0"
ActiveCell.Offset(, 4).Value = "0"
ActiveCell.Offset(, 5).Value = "0"
End If
If Cells(i, 1) = "107" Then
Cells(i, 1).Offset(1).Select
Range(Selection, Selection.Offset(, 5)).Select
Selection.Insert shift:=xlDown
ActiveCell.Offset(, 1).Value = "GGG"
ActiveCell.Offset(, 2).Value = "0"
ActiveCell.Offset(, 3).Value = "0"
ActiveCell.Offset(, 4).Value = "0"
ActiveCell.Offset(, 5).Value = "0"
End If
Next
End Sub
|
|