エクセルマクロで条件に該当する数値を探す

質問

エクセル初心者です。
シート１のＡ１～Ａ１８に１～１８の数値がランダムに入っています。（重複した値は無し）

シート２の３行目Ｃ３～Ｔ３にも１～１８の数値がランダムに入っています。（空欄あり、重複した数値は無し）

シート２の２行目Ｃ２～Ｔ２までは左から順に１～１８の数値が入っています。（順位表示）

以上の条件下で下記の作業をマクロで実行させる式を教えてください。

シート１のＡ１～Ａ１８の値と同じ値を、
シート２の３行目Ｃ３～Ｔ３の中からどのセル（列）に入っているかを確認して、さらに該当する列の２行目Ｃ２～Ｔ２の値を、シート３の１行目Ａ１～Ｒ１に表示させる。

例：シート１のＡ１＝３、Ａ２＝２、Ａ３＝１の時、
シート２のＣ３＝３、Ｄ３＝１、Ｅ３＝２でした。
シート２のＣ２＝１、Ｄ２＝２、Ｅ２＝３です（この行の数値は毎回同じ）
上記の時シート３にはＡ１＝１、Ｂ１＝３、Ｃ１＝２となります。
*シート１のＡ列Ａ１～Ａ１８とシート３の１行目Ａ１～Ｒ１の位置関係はリンクしています。（列→行）

シート１
Ａ列
１
３
２

シート２
　　Ａ列　Ｂ列　Ｃ列　Ｄ列　Ｅ列
２行見出し見出し１　　２　　３
３行見出し見出し３　　１　　２

シート３
Ａ列　Ｂ列　Ｃ列
　２　　１　　３

ご理解頂けたでしょうか？

初心者ですので分かりやすい回答を宜しくお願いいたします。

回答No.2

n-jun · ベストアンサー

>どの部分の式がどんな動作をさせているのか？

Sub　test()
　Dim　i　As　Long
　Dim　r　As　Range,　rr　As　Range
　Dim　v,　w,　x

　With　Worksheets("Sheet1")
　　　　　　　　　　　　'　ワークシート１のA1からA列の最終行までの値を配列として
　　　　　　　　　　　　'　vに与える。
　　　　　　v　=　.Range(.Range("A1"),　.Cells(Rows.Count,　1).End(xlUp)).Value
　End　With

　With　Worksheets("Sheet2")
　　　　　　　　　　　　'　検索対象の範囲（INDEX関数）を取得する。
　　　　　　　　　　　　'　対象はC2から一番右の列の３行目。
　　　　　　Set　r　=　.Range(.Range("C2"),　.Cells(3,　Columns.Count).End(xlToLeft))

　　　　　　　　　　　　'　上記で取得した範囲から検索対象の範囲（MATCH関数）として、
　　　　　　　　　　　　'　３行目だけとする。
　　　　　　Set　rr　=　Intersect(r,　.Rows(3))
　End　With

　　　　　　　　　　　　'　配列ｘの範囲を１列、vの行数とする。
　ReDim　x(1　To　1,　1　To　UBound(v,　1))

　For　i　=　1　To　UBound(v,　1)
　　　　　With　Application
　　　　　　　　　　　　'　ｒの範囲の１行目（WS2のC2の行）の値を取得するため
　　　　　　　　　　　　'　列数はMATCH関数でrrの範囲から検索する。
　　　　　　　　　　w　=　.Index(r,　1,　.Match(v(i,　1),　rr,　0))

　　　　　　　　　　　　'　上記で対象が見つからない場合エラーが変数ｗに入るので、
　　　　　　　　　　　　'　エラーの場合は表示は""（空白）とする。
　　　　　　　　　　x(1,　i)　=　IIf(IsError(w),　"",　w)
　　　　　End　With
　Next

　　　　　　　　　　　　'　WS3のA1から１行で列数はｖの行数分として、配列ｘを書き出す。
　Worksheets("Sheet3").Range("A1").Resize(1,　UBound(x,　2)).Value　=　x

　　　　　　　　　　　　'　以下は変数の解放。（Rangeと配列）
　Set　r　=　Nothing
　Set　rr　=　Nothing
　Erase　v,　x
End　Sub
こんな感じでしょうか。

>それから今回の質問ではシート２の３行目でしたが、他に４行目、５行目・・・と
>同じように調べるにはどの部分をアレンジすれば良いのでしょうか？
rrの行数を変更するか、連続で行なう場合ならもう一段For ～ Nextの
ループでrrをOffsetしていくことかな。（未検証ですけど）

お礼

分かり易い説明をして頂き解決しました。
ありがとうございました。

回答No.3

imogasi

>エクセルマクロで条件に該当する数値を探す
内容を見ると、Excel通常関数でも出来そうな、ように見えるがExcel
VBAでやりたいのですか。
＞初心者ですので分かりやすい回答を宜しくお願いいたします。
基本的にこのコーナーはヒントとして回答をもらい、後は質問者が勉強するなり、考えるべきだ。
そもそもこの質問は、丸投げの質問で、質問コーナーの規約から望ましくない。
回答が出る前から、＞分かりやすいかどうか判らないわけで、回答に注文をつけるべきでない。
ーーー
データに重複が無いと言うことなのでExcel関数のMATCH,VLOOKUP
などに好都合。
ーー
まず関数でやってみる。
例データ
Sheet1
A1:B４
aa bb
1 2
3 1
2 3
質問ではSheet3に出したいらしいが、Sheet1に出すと
B2の式は
=INDEX(Sheet2!$C$2:$H$2,1,MATCH(A2,Sheet2!$C$3:$H$3,0))
下方向に式を複写。結果上記。
ーー
VBAならOFFSETとMATCH関数を使って
質問ではSheet3に出したいらしいが、Sheet1のD列に出すと
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
'------
d = sh1.Range("A65536").End(xlUp).Row
For i = 2 To d
n = WorksheetFunction.Match(sh1.Cells(i, "A"), sh2.Range("C3:H3"), 0)
'MsgBox n
sh1.Cells(i, "D") = sh2.Range("B2").Offset(0, n)
Next i
End Sub
少数例しかテストして無いので質問を誤解してないか心配だが。
＃１のお礼を見るとVBAをやって間もないようだが、わかるかな。
上記のように関数利用だと関数がわかる人には判りやすいと思うが。

回答No.1

n-jun

Sub　test()
　Dim　i　As　Long
　Dim　r　As　Range,　rr　As　Range
　Dim　v,　w,　x

　With　Worksheets("Sheet1")
　　　　　　v　=　.Range(.Range("A1"),　.Cells(Rows.Count,　1).End(xlUp)).Value
　End　With

　With　Worksheets("Sheet2")
　　　　　　Set　r　=　.Range(.Range("C2"),　.Cells(3,　Columns.Count).End(xlToLeft))
　　　　　　Set　rr　=　Intersect(r,　.Rows(3))
　End　With

　ReDim　x(1　To　1,　1　To　UBound(v,　1))

　For　i　=　1　To　UBound(v,　1)
　　　　　With　Application
　　　　　　　　　　w　=　.Index(r,　1,　.Match(v(i,　1),　rr,　0))
　　　　　　　　　　x(1,　i)　=　IIf(IsError(w),　"",　w)
　　　　　End　With
　Next

　Worksheets("Sheet3").Range("A1").Resize(1,　UBound(x,　2)).Value　=　x
　Set　r　=　Nothing
　Set　rr　=　Nothing
　Erase　v,　x
End　Sub
こうゆう感じのことですか？

補足

ありがとうございます。
希望通りに実行できました。
お願いがあるのですが、どの部分の式がどんな動作をさせているのか？
簡単に説明を入れて頂けると応用出来るかも知れませんので、
教えて頂けませんか？
それから今回の質問ではシート２の３行目でしたが、他に４行目、５行目・・・と同じように調べるにはどの部分をアレンジすれば良いのでしょうか？
シート２の２行目を見るのはずーと同じです。
宜しくお願いいたします。