6列を配列に取込し1列を検索値、2列を書出ししたい

質問

シート（抜取マスタ）のＡ列と
シート（マスタ全部）のＡ列をぶつけてヒットしたら
シート（マスタ全部）の該当行のＥ列を抜取マスタのＦ列に転記
するマクロを
ヒットしたら
シート（マスタ全部）の該当行のＥ，Ｆ列を抜取マスタのＦ，Ｇ列に転記
とか
シート（マスタ全部）の該当行のＤ，Ｆ列を抜取マスタのＦ，Ｇ列に転記
シート（マスタ全部）の該当行のＥ，Ｆ列を抜取マスタのＦ，Ｈ列に転記
に改造したいです。
●部分を修正しなければと思っていますが
思ったように動きません。教えてください。
よろしくお願いします。

Sub 検索貼付()

'シート（抜取マスタ）のＡ列と
'シート（マスタ全部）のＡ列をぶつけてヒットしたら
'シート（マスタ全部）の該当行のＥ,Ｆ列を抜取マスタのＦ，Ｇ列に転記
'データは２列目から開始
'ヒットしない場合は　無し　と記入

Dim dic As Object
Dim i As Long
Dim v, w
Dim t As Single
t = Timer
With Sheets("マスタ全部")
'シート（マスタ全部）のデータを配列に取込
'（F2の部分とCount, 1の部分 →A～F列となる）
With .Range("F2", .Cells(.Rows.Count, 1).End(xlUp))
'Vに代入する事となる、検索する列の指定.Columns(1)=A列
v = .Columns(1).Value
'Wに代入する事となる、書出す値のある列の指定　(5)=E列
●w = .Columns(5).Value
End With
End With
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(v)
dic(v(i, 1)) = i
Next
With Sheets("抜取マスタ")
'検索値のある列指定（A2の部分とCount, 1の部分→A列～A列)
With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
v = .Value
For i = 1 To UBound(v)
If dic.exists(v(i, 1)) Then
v(i, 1) = w(dic(v(i, 1)), 1)
Else
'ヒットしない場合
v(i, 1) = "無"
End If
Next
'書き出しする列を指定（Offset(, 5)=検索値のA列より右5つ→F列）
●With .Offset(, 5)
.ClearContents
.NumberFormat = "@"
.Value = v
End With
End With
End With
Set dic = Nothing
Debug.Print Timer - t
End Sub

回答No.1

merlionXX · ベストアンサー

Sub 検索貼付02()
'シート（抜取マスタ）のＡ列と
'シート（マスタ全部）のＡ列をぶつけてヒットしたら
'シート（マスタ全部）の該当行のＥ,Ｆ列を抜取マスタのＦ，Ｇ列に転記
'データは２列目から開始
'ヒットしない場合は　無し　と記入
Dim dic As Object
Dim i As Long
Dim v, w, vv '●
Dim t As Single
t = Timer
With Sheets("マスタ全部")
'シート（マスタ全部）のデータを配列に取込
'（F2の部分とCount, 1の部分 →A～F列となる）
With .Range("F2", .Cells(.Rows.Count, 1).End(xlUp))
'Vに代入する事となる、検索する列の指定.Columns(1)=A列
v = .Columns(1).Value
'Wに代入する事となる、書出す値のある列の指定=E:F
w = .Columns("E:F").Value '●
End With
End With
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(v)
dic(v(i, 1)) = i
Next
With Sheets("抜取マスタ")
'検索値のある列指定（A2の部分とCount, 1の部分→A列～A列)
With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
v = .Value
ReDim vv(1 To UBound(v), 1 To 2) '●
For i = 1 To UBound(v)
If dic.exists(v(i, 1)) Then
vv(i, 1) = w(dic(v(i, 1)), 1) '●
vv(i, 2) = w(dic(v(i, 1)), 2) '●
Else
'ヒットしない場合
vv(i, 1) = "無" '●
vv(i, 2) = "無" '●
End If
Next
'書き出しする列を指定（Offset(, 5)=検索値のA列より右5つ→F列+1列）
With .Offset(, 5).Resize(, 2) '●
.ClearContents
.NumberFormat = "@"
.Value = vv
End With
End With
End With
Set dic = Nothing
Debug.Print Timer - t
End Sub

では？
少しでも修正したところに●してあります。

お礼

半日以上、考えて完成できませんでした。
でその試行錯誤したときの
動かない自分の修正内容と
今回教えていただいた物とは
全然かけはなれていました。

思ったとおり動きました。
どうもありがとうございました。

回答No.2

end-u

#修正コード出た後じゃあまり意味ないレスかもしれませんけど。

提示されたサンプルコードを元に、
自分で勉強して
自分で使いこなせるようになろうとは思わないですか？
http://okwave.jp/qa/q6327928.html?order=asc
安易に"scripting.dictionary"を用いたコードを紹介した私が悪いと言えば
まあ、そうなんでしょうけど。
dictionaryというより、配列に対する理解でしょうかね。

http://excelvba.pc-users.net/
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/index.html
http://www.asahi-net.or.jp/~ef2o-inue/top01.html

基礎からやり直したほうが良いです。

それに、考え方次第です。
現状コードの
マスタ全部のE→抜取マスタのF
これを
マスタ全部のD→抜取マスタのF
マスタ全部のF→抜取マスタのG
マスタ全部のF→抜取マスタのH
このように変更する事くらいは自力でできますよね。

例えばデータ量がそう多くない時に
F、G列それぞれにVLOOKUP式を入れて値を引っ張ってくる事ってあると思います。
それと一緒です。
F列、G列それぞれ単独で別々のプロシージャを２回走らせればできます。

そこから重複処理をまとめて１本化したり、
列の変動をInputBox形式で処理できるように汎用化したり。
【自分で】工夫してください。

元コードの内容に対する理解が前提なのは言うまでもない事ですが。

お礼

返事が送れて申し訳ありません。
色々とありがとうございました。