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 回答日時： 2006/07/08 12:57

> まず項目IDの列をB501で検索かけて見つかったら

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

この回答へのお礼

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

お礼日時：2006/07/09 21:32

No.3 回答者： NCU 回答日時： 2006/07/08 14:21

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

No.2 回答者： imogasi 回答日時： 2006/07/08 14:05

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は
元データ
場所 　　　　　　保育所　　　　 　 　　
項目IDB501 　　B502
B501 　　B501 　　B502B502
　年　 2002200320022003
松戸市35543554
船橋市21352135
市川市15231523
(注）第４行目は人手で行挿入しておいて実行します。上記は、結果です。
Sheet2
更新用データ
場所 保育所
項目ID B501 B502
　年　　20042004
松戸市25325
船橋市45345
市川市31331
結果　Sheet3（実質B3:G8)


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

この回答へのお礼

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

お礼日時：2006/07/09 21:39