Matchの処理について

質問

下記の処理がどうしてもうまくいかなくて、
皆様のお知恵を拝借できればありがたいです。

Sheet1に下記のように縦に３列データがならんでいます。

A　　あ　　10
A　　い　　12
A　　う　　16
B　　あ　　19
B　　い　　15
B　　う　　 7

これをもとにSheet2に下記の通りマトリクス形式に
変換する。

　　あ　　い　　う
A 　10　　12　　16
B 　19　　15　　 7

これを処理しようと以下の通り記述したのですが、
マッチする項目がなかった場合、どうも行（列）が
ずれてヒットしているようです。
On Error Resume Nextが原因のような気がするのですが。

これを回避するにはどうしたらよろしいでしょうか？
お助けください～。
よろしくお願い致します。

Dim i As Long
Dim j As Long
Dim k As Long
Dim 検索値A As Variant
Dim 検索値B As Variant
On Error Resume Next

i = 2

Do While (Sheets("SHEET1").Cells(i, 1) <> "")
検索値A = Sheets("SHEET1").Cells(i, 1).Value
検索値B = Sheets("SHEET1").Cells(i, 2).Value

j = Application.Match(検索値A, Sheets("Sheet2").Range("範囲A"), 0)
k = Application.Match(検索値B, Sheets("Sheet2").Range("範囲B"), 0)

Sheets("Sheet2").Cells(j, k).Value =Sheets("SHEET1").Cells(i, 3)

i = i + 1

Loop

End Sub

回答No.2

Wendy02 · ベストアンサー

こんにちは。

コードをみると、いくつか直したいところがありますね。
#1 のBLUEPIXYさんのご指摘の部分は、

最初に、データを入れる範囲を決めておいても良いと思います。

例:
同じやり方をするなら、[挿入]－[名前] －[定義]で、
　名前:"データ"　,参照範囲:Sheet2!B2:D3

このようにします。

　　Sheets("Sheet2").Range("データ").Cells(j, k).Value = Sheets("SHEET1").Cells(i, 3).Value

それから、次に、

＞On Error Resume Nextが原因のような気がするのですが。

On Error Resume Next　でエラーを排出しても、それは、値もエラーも残ったままです。それでは、On Error の意味がありません。

そのままのコードを生かすなら、以下のように、エラー処理をします。

Do While (Sheets("SHEET1").Cells(i, 1) <> "")
　　検索値A = Sheets("SHEET1").Cells(i, 1).Value
　　検索値B = Sheets("SHEET1").Cells(i, 2).Value
　　j = Application.Match(検索値A, Sheets("Sheet2").Range("範囲A"), 0)
　　k = Application.Match(検索値B, Sheets("Sheet2").Range("範囲B"), 0)
　　If Err.Number = 0 Then
　　Sheets("Sheet2").Range("データ").Cells(j, k).Value = Sheets("SHEET1").Cells(i, 3).Value
　　Else
　　j = 0: k = 0: Err.Clear
　　End If
　　i = i + 1
　Loop

ただ、これは、On Error で回避するレベルのエラーではありません。Match の戻り値の宣言型の違いから出るエラーです。Match の戻り値は、見つからない場合の戻り値も吐き出しているので、本来は、On Error トラップを使わなくても、IsErrorで、戻り値を Variant にするだけで使えます。

お礼

ご回答ありがとうございます！

ご教示いただいたおかげで、当初の問題は解決
できました。本当に助かりました。ありがとう
ございます！

ただ、もう１つ問題が発生致しまして...
"検索値A"の一部については特定の行にデータを
セットしたいのです。その一部の"検索値A"と
いうのは例えば"aaa300"、"bbb300"等、"300"で
終わるもので、これらは特定行に固定したいという
感じです。ワイルカードを使えないものかといろいろ
調べておりますが、よくわかりません。。

たいへんドあつかましくて申し訳ございませんが、
もし目に留まりましたら、ご教示頂けましたら
幸いです。重ね重ね申し訳ありません。

回答No.5

imogasi

この質問はあげてある例が、不適当で、何がやりたいのか伝わらないのでは。すでに出ている質問で解決したのかどうかもよく読めないのですが。
もし下記のような問題なら参考に。でないなら、無視してください。
Ａ２：Ｃ１０
a あ 1
a う 3
a え 4
b あ 56
b い 6
c あ 7
c い 8
d い 45
d え 56
これを
Ａ１：Ｅ５
あ う え い
a 1 3 4
b 56 6
c 7 8
d 56 45
に組み替えると解釈した。
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
'---Sheet1の最終行
d = sh1.Range("A65536").End(xlUp).Row
'------最初行
i = 2 'sheet1
i2 = 2: j2 = 2 'sheet2
sh2.Cells(i2, "A") = sh1.Cells(i, "A")
sh2.Cells(1, "B") = sh1.Cells(i, "B")
sh2.Cells(i2, j2) = sh1.Cells(i, "C")
m = sh1.Cells(i, "A")
'-----その次行から
For i = 3 To d
If sh1.Cells(i, "A") = m Then
'前行と同じなら
r = sh2.Range("IV1").End(xlToLeft).Column 'sheet2第１行の最右列
For j = 2 To r 'sheet1のＢ列とsheet2の第１行で同じ列を探す
If sh2.Cells(1, j) = sh1.Cells(i, "B") Then 'Sheet2第１行とsheet1Ｂ列が等しいか
sh2.Cells(i2, j) = sh1.Cells(i, "C")
GoTo p01
End If
Next j
'j は最右列の次列をさしている
sh2.Cells(1, j) = sh1.Cells(i, "B")
sh2.Cells(i2, j) = sh1.Cells(i, "C")
p01:
Else
'前行と変わった
i2 = i2 + 1 'sheet2の次行へ進む
sh2.Cells(i2, "A") = sh1.Cells(i, "A") 'sheet2のＡ列セット
r = sh2.Range("IV1").End(xlToLeft).Column 'sheet2第１行の最右列
For j = 2 To r
If sh2.Cells(1, j) = sh1.Cells(i, "B") Then
sh2.Cells(i2, j) = sh1.Cells(i, "C")
GoTo p02
End If
Next j
' j は最右列の次列をさしている
sh2.Cells(1, j) = sh1.Cells(i, "B")
sh2.Cells(i2, j) = sh1.Cells(i, "C")
p02:
m = sh1.Cells(i, "A")
End If
Next i

End Sub

回答No.4

BLUEPIXY

＃１です、他の方の回答を見て今さらですが
＃１のような単なるズレの話ではなくマッチするものが無い場合の処理の話だと気がつきました。
勘違いコメントですみません。＜（＿ ＿＞

でも、言い訳させていただくと、
もともとの表を移し替えるだけなのですから
（２重のデータが有る場合におかしくなることはあっても）
マッチしない場合があるとは考えにくいと思います

お礼

こちらこそ説明不足で大変申し訳ございません。

状況的にはSheet2にセットすべきデータと
もとのSheet1のデータはイコールではなく、
Sheet1にはSheet2には該当しないものが多数
含まれているという感じです。

おかげさまで当初の問題は解決致しましたが、
下にも記述したとおり、さらなる問題が
発生して、行き詰ってます（T_T）

とにかく、お世話になりありがとうございました。

回答No.3

taocat

こんにちは。
既に回答は出ていますが、ちょと一言。

今回の場合、On Error Resume Nextはなかなかいい方法だと思います。
但し、あとちょっと思案すれば・・・(^^;;;

もし、提示のコードをこのまま使うとしたら
下記のように●の位置で　j,k　をクリアーするだけでＯＫです。
----------------------------------------------

Do While (Sheets("SHEET1").Cells(i, 1) <> "")
検索値A = Sheets("SHEET1").Cells(i, 1).Value
検索値B = Sheets("SHEET1").Cells(i, 2).Value

　　●　j=0
　　●　k=0

j = Application.Match(検索値A, Sheets("Sheet2").Range("範囲A"), 0)
k = Application.Match(検索値B, Sheets("Sheet2").Range("範囲B"), 0)
-------------------------------------------------

（理由）
例えば、データが下記のようになっていた場合

Ａ　い　（該当あり）
Ｅ　ら　（該当なし）

該当あり「Ａい」の戻り値が、j=2,k=3　となったとしますと
次の該当なし「Ｅら」は、MATCHでエラーとなり、
On Error Resume Nextで次の行にジャンプします。
ということは、j,kは、前の該当データ「Ａい」の戻り値のままということになりますよね。
ですから、質問のようになったわけです。

もちろん、片方の値だけ該当した場合は、該当しなかった値の戻り値だけが前の戻り値のままということになります。
例えば、「Ｅう」　j=2(「Ａ」の戻り値のまま）,K=4（「う」の戻り値）

意図せぬ結果になったときは、本物のデータではなくて、簡単な例を使い、変数の値を一つずつ確かめてみることをお薦めします。
以上です。

お礼

ご丁寧な回答ありがとうございます。

コーディングをしていても、実際どういう
動きをしているのか、よくわからなかったのですが、
ご回答の内容を拝見して、イメージが沸きました。

本当にありがとうございます！

回答No.1

BLUEPIXY

Cells(row,col)
のrowとcolは１からはじまります
つまり
Cells(1,1)はA1になります。
また
Ａ，Ｂ，Ｃと並びがあるときＭａｔｃｈが返すマッチした位置も１からはじまります。
なので、（Ａ，あ）というのをMatchで探すと（１，１）になります。
ところが、
　Ａ　Ｂ　Ｃ　Ｄ
１　　あ　い　う
２Ａ
３Ｂ
ですから
（Ａ，あ）は、
上記でCellsでいうと（２，２）になりますから位置がずれることになります。
結局（１，１）ずれていることになるので、
Sheets("Sheet2").Cells(j+1, k+1).Value =Sheets("SHEET1").Cells(i, 3)
してやればいいような気がします

お礼

ご回答ありがとうございます！

説明不足でわかりにくかったと思いますが、
ご教示ありがとうございました。

参考にさせていただきます。