|
▼ichinose さん:
基準になる表が必要な事が良く分かりました。
それを別シートに作成して活用する事ですね。汎用性があって今後また
他のところにも、使わせていただきます。
素晴らしいマクロに、ちょっとついていけないのが事実です。
戸惑いを感じながらも、これで進めそうです。ありがとうございました。
幼稚なことを考え、自分なりに、コードを作成しました。
元の表は下のようなレイアウトになっています。
大体欠落する行が103のPPP、105のEEE、108のGGGです。
それで、それを踏まえてコードにしました。
しかし、マクロを2回しないと108のGGGが入ってくれません。
どこを直すと1回の操作で行くのでしょうか。もし時間が有りましたら
教えてください。
Sub 表の補完作成1()
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
If Selection.Value <> "103" Then
Range(Selection, Selection.Offset(, 5)).Select
Selection.Insert shift:=xlDown
ActiveCell.Value = "103"
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
End If
If Cells(i, 1) = "104" Then
Cells(i, 1).Offset(1).Select
If Selection.Value <> "105" Then
Range(Selection, Selection.Offset(, 5)).Select
Selection.Insert shift:=xlDown
ActiveCell.Value = "105"
ActiveCell.Offset(, 1).Value = "EEE"
ActiveCell.Offset(, 2).Value = "0"
ActiveCell.Offset(, 3).Value = "0"
ActiveCell.Offset(, 4).Value = "0"
ActiveCell.Offset(, 5).Value = "0"
End If
End If
If Cells(i, 1) = "107" Then
Cells(i, 1).Offset(1).Select
If Selection.Value <> "108" Then
Range(Selection, Selection.Offset(, 5)).Select
Selection.Insert shift:=xlDown
ActiveCell.Value = "108"
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
End If
Next
End Sub
A B C D E F G
項目1 項目2 項目3 項目4 項目5 項目6
5 101 AAA 500 300 200 500
6 102 BBB 400 100 50 400
7 104 DDD 600 0 250 600
8 107 FFF 600 0 0 600
9 109 HHH 180 80 50 180
|
|