特定文字を検索し、その行の数字を別のセルへ移す

質問

特定文字を検索し、その行の座標を別のセルへ移すには、エクセルVBA では
どのようなコードを記入すればよろしいでしょうか？

H列に記入されている「：Q」がある行を検索します。（黄枠）
その行を確認すると番地の列にA10(緑枠）、A30（赤枠）という文字があります。
８行目と10行目の同じように番地の箇所にA10又はA30と記入してある行の
I,J,K,Lに(緑枠）、（赤枠）の行のXとYの座標を移動できないでしょうか？
・移動先行のＨ列は必ず「：M」と記入してあります
・座標を移動した後は、最終的に「：Q」の行は削除します
・図では、４行目の座標がK,L、５行目の座標がI,Jに来ていますが、逆でも大丈夫です。
（６,７行目も同じです）

エクセルは2007を使用しております。
よろしくお願い致します。

回答No.1

keithin · ベストアンサー

＞移動先行のＨ列は必ず「：M」と記入してあります

簡単のため「：Ｑ」の番地に対応する「：Ｍ」の番地は「必ず用意されている」とします。
また「：」の文字や、ＱやＭの「全角半角」は「間違いなくご相談に情報提供されているのと一致して統一できている」とします。

マクロ自体は淡々と「無くなるまで繰り返す」だけの、単純な構造でできます。

手順：
ＡＬＴ＋Ｆ１１を押してＶＢＥ画面を開く
挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim h as range
　dim Target as range

’Ｑのデータを探す
　set h = range("H:H").find(what:="：Q", lookin:=xlvalues, lookat:=xlwhole)
　do until h is nothing

　’Ｍの行を探す
　　set target = range("E:E").find(what:=cells(h.row, "E").value, lookin:=xlvalues, lookat:=xlwhole)
　　do until cells(target.row, "H") = "：M"
　　　set target = range("E:E").findnext(target)
　　loop

　’移動する
　　cells(target.row, "IV").end(xltoleft).offset(0, 1).value = cells(h.row, "A").value
　　cells(target.row, "IV").end(xltoleft).offset(0, 1).value = cells(h.row, "C").value
　　h.entirerow.clearcontents
　’または
　’h.entirerow.delete shift:=xlshiftup

　　set h = range("H:H").find(what:="：Q", lookin:=xlvalues, lookat:=xlwhole)
　loop
end sub

ファイルメニューから終了してエクセルに戻る
ＡＬＦ＋Ｆ８を押してマクロを実行する。

お礼

勉強になりました。
ありがとうございました。