回答なしなのでもう一度 図がみにくいですか？

質問

該当するセルに転記するマクロなんですが

例）
【図(1)】のa801蜜柑は、a801から"a"でbook2のsheet2を検索、"8"から8Aを検索、"01"から１を検索し、【図２】のE3が該当セルになります。
【図(1)】のb808西瓜は、b808から"b"でbook2のsheet3を検索、"8"から8Bを検索、"08"から８を検索し、【図(3)】のC44が該当セルになります。

回答No.2

keithin · ベストアンサー

私の画面では何が記入してあるのか全然判らないんですが，あなたの画面では見えているのでしょうか。

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

’検索元データの所在をキチンとマクロに組み込むこと
　worksheets("Sheet1").select
　for each h in range("A1:A" & range("A65536").end(xlup).row)

’対象シートを特定する
’ブック名拡張子シート名とかキチンとマクロに組み込むこと
　select case left(h.value, 1)
　case "a"
　　set w = workbooks("Book2.xlsx").worksheets("Sheet2")
　case "b"
　　set w = workbooks("Book2.xlsx").worksheets("Sheet3")
　case else
　　msgbox "MISSING1"
　　exit sub
　end select

’対象グループを特定する
’ただし対象シートの「どこを」探せばいいのかキチンとマクロを修正する事
　set target = w.range("F:F").find(what:= mid(strconv(h.value, 2, 1) & mid(h.value, 1, 1), vbuppercase), lookin:=xlvalues, lookat:=xlwhole)
　if target is nothing then
　　msgbox "MISSING2"
　　exit sub
　end if

’０１等を検索する
　set target = target.offset(0, -5).range("A1:E1,A4:E4")
　set target = target.find(what:=val(mid(h.value, 3, 2)), lookin:=xlvalues, lookat:=xlwhole)
　if target is nothing then
　　msgbox "MISSING3"
　　exit sub
　end if

’結果を転記する
’ただし見つけたどこを取ってきたいのか不明なので，適切に修正すること
　h.offset(0, 1).value = target.offset(2).value

　next
end sub

お礼

http://i.imgur.com/YDiOVdv.jpg

ここに図をアップしてみました。
【図(1)】行数は可変です。
【図(2)と(3)】行列とも可変です。6行単位のくくりがいくつもあります

補足

missing1 が出てすすみません。

回答No.3

keithin

ん？

＞missing1 が出てすすみません。

再掲：
＞検索元データの所在をキチンとマクロに組み込むこと

Ａ２からデータがあるならそのように手直します。

回答No.1

asciiz

＞図がみにくいですか？

はい、見にくいです
画像は規定のサイズに縮小されてしまい、画像の中の文字は読めなくなっています。
「蜜柑」も「西瓜」も、どこに書いてあるのか分からないです。

このサイトの機能で画像を登録するのではなく、どこかよそのアップローダとか、自分のホームページスペースなどにアップロードしておいて、画像URLをリンクすると良いでしょう。

＞回答なしなのでもう一度　

あなたの元の質問が何なのか、分かりません。

こうして別に投稿された質問は、元の質問とは全く関連が無く、他者からは見つけられません。
あなたの質問履歴が公開されていれば、辿れ無くもないのですが、基本的には1投稿の中で質問が完結するようにお願いします。
(このサイトの使い方の規則でそうなっていますので)

お礼

http://i.imgur.com/YDiOVdv.jpg

ここにアップしてみました。
【図(1)】A列B列とも行数は可変です。
【図(2)】【図(3)】も行数は可変です。上に9Aもあれば下に1Aもあります。