VBAでの列の挿入

質問

元データ
場所 ｜　　　　　　保育所　　　　 　 　　｜
項目ID｜　　 B501 　　｜　　 B502 　 　｜
　年　 ｜ 2002｜ 2003　｜ 2002｜ 2003｜
松戸市｜　35　｜　54　｜　35　｜　54　｜
船橋市｜　21　｜　35　｜　21　｜　35　｜
市川市｜　15　｜　23　｜　15　｜　23　｜

更新用データ
場所 ｜保育所｜
項目ID｜ B501 ｜
　年　　｜ 2004 ｜
松戸市｜　25　｜
船橋市｜　45　｜
市川市｜　31　｜

更新した後の表示
場所 ｜　　　　　　　　保育所　　　　　　　　　　　　　｜
項目ID｜　　　　 B501 　　 　　　｜　　 B502 　　　　｜
　年　 ｜ 2002 ｜ 2003 ｜ 2004 ｜ 2002 ｜ 2003 ｜
松戸市｜　35　｜　54　｜　25　｜　10　｜　50　｜
船橋市｜　21　｜　35　｜　45　｜　20　｜　16　｜
市川市｜　15　｜　23　｜　31　｜　25　｜　23　｜

見づらくて申し訳ないです。
上の表みたいなデータの更新をしたくて
まず項目IDの列をB501で検索かけて見つかったら空白の行を挿入してと
考えていたのですがセルが結合していたりと
全然思ったように動きません。

どのように記述すればよいか教えていただけないでしょうか。
よろしくお願いいたします。

回答No.1

misatoanna · ベストアンサー

> まず項目IDの列をB501で検索かけて見つかったら
で、ここまではできていて、B501 が入力されている結合されたセルが選択されていると
します。
この選択されている結合セルの「１つ右で１つ下のセル」を選択して列挿入等の処理を
行なえばよいのではないでしょうか。
　Selection.Offset(1, 1).Select
　Selection.EntireColumn.Insert
　Range(Selection.Offset(-1, 0), Selection.Offset(-1, -1)).Merge
あとは、この時点で選択されているセル以下に「更新用データ」を落とし込みます。

お礼

アドバイスありがとうございました。
まだ完全には動かないんですけど
上記のように処理をさせたら
以前よりは理想に近づいてきたので
もう少し頑張ってみます

回答No.3

NCU

結合でなく、横位置を「選択範囲内で中央」にしておけばよろしいのでは？

回答No.2

imogasi

Sub test01()
'---シート設定
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set sh3 = Worksheets("Sheet3")
'Rows(3).EntireRow.Insert
'---Sh1の第3行目マージセルを第４行に分解
For j = 2 To 10
'MsgBox Cells(3, j)
If sh1.Cells(3, j).MergeCells = True Then
If sh1.Cells(3, j) = "" Then
sh1.Cells(4, j) = m
Else
m = sh1.Cells(3, j)
sh1.Cells(4, j) = m
End If
End If
Next j
'---右端列の取得
c1 = sh1.Range("iv5").End(xlToLeft).Column
c2 = sh2.Range("iv4").End(xlToLeft).Column
'--初期列の設定
x = 2: y = 2: z = 2
'---列マージ
agn:
'---マージ用キーの設定
k1 = Trim(sh1.Cells(4, x)) & Trim(sh1.Cells(5, x))
k2 = Trim(sh2.Cells(3, y)) & Trim(sh2.Cells(4, y))
'MsgBox k1 & " " & k2
'---キー比較
If k1 > k2 Then GoTo high
If k1 = k2 Then GoTo eql
If k1 < k2 Then GoTo low
'---第１キー＞第２キー
high:
For i = 3 To 8
sh3.Cells(i + 1, z) = sh2.Cells(i, y)
Next i
y = y + 1
If y > c2 Then
sh2.Cells(3, y) = "Z999"
sh2.Cells(4, y) = "'9999"
End If
z = z + 1
GoTo agn
'-----第１キー＝第２キー
eql:
If k1 = "Z9999999" Then GoTo owari
For i = 2 To 7
sh3.Cells(i + 1, z) = sh2.Cells(i, y)
Next i
x = x + 1
If x > c1 Then
sh1.Cells(4, x) = "Z999"
sh1.Cells(5, x) = "'9999"
End If
y = y + 1
If y > c2 Then
sh2.Cells(3, y) = "Z999"
sh2.Cells(4, y) = "'9999"
End If
z = z + 1
GoTo agn
'----第１キー＜第２キー
low:
For i = 3 To 8
sh3.Cells(i, z) = sh1.Cells(i, x)
Next i
x = x + 1
If x > c1 Then
sh1.Cells(4, x) = "Z999"
sh1.Cells(5, x) = "'9999"
End If
z = z + 1
GoTo agn
'----終了
owari:
'--作業的余分なもの消去
sh1.Cells(4, c1 + 1) = ""
sh1.Cells(5, c1 + 1) = ""
sh2.Cells(3, c2 + 1) = ""
sh2.Cells(4, c2 + 1) = ""
End Sub
データ例
Sheet1は
元データ
場所&nbsp;&nbsp; 　　　　　　保育所　　　　 　 　　
項目ID B501 　　 B502
B501 　　 B501 　　 B502 B502
　年　&nbsp; 2002 2003 2002 2003
松戸市 35 54 35 54
船橋市 21 35 21 35
市川市 15 23 15 23
(注）第４行目は人手で行挿入しておいて実行します。上記は、結果です。
Sheet2
更新用データ
場所&nbsp;&nbsp; 保育所
項目ID B501 B502
　年　　 2004 2004
松戸市 25 325
船橋市 45 345
市川市 31 331
結果　Sheet3（実質B3:G8)

B501 　　 B502
B501 　　 B501 　　 B501 B502 B502 B502
2002 2003 2004 2002 2003 2004
35 54 25 35 54 325
21 35 45 21 35 345
15 23 31 15 23 331
（注記）
人の組んだプログラムを読解するのは難しいものですがよろしく。
Sheet3の見出し文字列のセットは、プログラムが長くなるので省略してます。手作業でSheet3に入れるか、プログラムで代入文を加えてください。
項目IDと年は文字列で統一し、前後とも余分なスペースが混じらないように考えてください。そうしないと、制御が崩れ、結果がむちゃくちゃになります。
Sheet3のセルのマージはできていません。とりあえず見切りで上げます。
上記は定番のマージのロジックを使ってます。

お礼

まだ完全には理解できていないのですが
こういった方法でも処理する方法があるということを
学べましたので少しだけ賢くなったような気がします。
ありがとうございました。