下記の処理がどうしてもうまくいかなくて、
皆様のお知恵を拝借できればありがたいです。
Sheet1に下記のように縦に3列データがならんでいます。
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.1
- 回答日時:
Cells(row,col)
のrowとcolは1からはじまります
つまり
Cells(1,1)はA1になります。
また
A,B,Cと並びがあるときMatchが返すマッチした位置も1からはじまります。
なので、(A,あ)というのをMatchで探すと(1,1)になります。
ところが、
A B C D
1 あ い う
2A
3B
ですから
(A,あ)は、
上記でCellsでいうと(2,2)になりますから位置がずれることになります。
結局(1,1)ずれていることになるので、
Sheets("Sheet2").Cells(j+1, k+1).Value =Sheets("SHEET1").Cells(i, 3)
してやればいいような気がします
ご回答ありがとうございます!
説明不足でわかりにくかったと思いますが、
ご教示ありがとうございました。
参考にさせていただきます。
No.2ベストアンサー
- 回答日時:
こんにちは。
コードをみると、いくつか直したいところがありますね。
#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 にするだけで使えます。
ご回答ありがとうございます!
ご教示いただいたおかげで、当初の問題は解決
できました。本当に助かりました。ありがとう
ございます!
ただ、もう1つ問題が発生致しまして...
"検索値A"の一部については特定の行にデータを
セットしたいのです。その一部の"検索値A"と
いうのは例えば"aaa300"、"bbb300"等、"300"で
終わるもので、これらは特定行に固定したいという
感じです。ワイルカードを使えないものかといろいろ
調べておりますが、よくわかりません。。
たいへんドあつかましくて申し訳ございませんが、
もし目に留まりましたら、ご教示頂けましたら
幸いです。重ね重ね申し訳ありません。
No.3
- 回答日時:
こんにちは。
既に回答は出ていますが、ちょと一言。
今回の場合、On Error Resume Nextはなかなかいい方法だと思います。
但し、あとちょっと思案すれば・・・(^^;;;
もし、提示のコードをこのまま使うとしたら
下記のように●の位置で j,k をクリアーするだけでOKです。
----------------------------------------------
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)
-------------------------------------------------
(理由)
例えば、データが下記のようになっていた場合
A い (該当あり)
E ら (該当なし)
該当あり「Aい」の戻り値が、j=2,k=3 となったとしますと
次の該当なし「Eら」は、MATCHでエラーとなり、
On Error Resume Nextで次の行にジャンプします。
ということは、j,kは、前の該当データ「Aい」の戻り値のままということになりますよね。
ですから、質問のようになったわけです。
もちろん、片方の値だけ該当した場合は、該当しなかった値の戻り値だけが前の戻り値のままということになります。
例えば、「Eう」 j=2(「A」の戻り値のまま),K=4(「う」の戻り値)
意図せぬ結果になったときは、本物のデータではなくて、簡単な例を使い、変数の値を一つずつ確かめてみることをお薦めします。
以上です。
ご丁寧な回答ありがとうございます。
コーディングをしていても、実際どういう
動きをしているのか、よくわからなかったのですが、
ご回答の内容を拝見して、イメージが沸きました。
本当にありがとうございます!
No.4
- 回答日時:
#1です、他の方の回答を見て今さらですが
#1のような単なるズレの話ではなくマッチするものが無い場合の処理の話だと気がつきました。
勘違いコメントですみません。<(_ _>
でも、言い訳させていただくと、
もともとの表を移し替えるだけなのですから
(2重のデータが有る場合におかしくなることはあっても)
マッチしない場合があるとは考えにくいと思います
こちらこそ説明不足で大変申し訳ございません。
状況的にはSheet2にセットすべきデータと
もとのSheet1のデータはイコールではなく、
Sheet1にはSheet2には該当しないものが多数
含まれているという感じです。
おかげさまで当初の問題は解決致しましたが、
下にも記述したとおり、さらなる問題が
発生して、行き詰ってます(T_T)
とにかく、お世話になりありがとうございました。
No.5
- 回答日時:
この質問はあげてある例が、不適当で、何がやりたいのか伝わらないのでは。
すでに出ている質問で解決したのかどうかもよく読めないのですが。もし下記のような問題なら参考に。でないなら、無視してください。
A2:C10
aあ1
aう3
aえ4
bあ56
bい6
cあ7
cい8
dい45
dえ56
これを
A1:E5
あうえい
a134
b566
c78
d5645
に組み替えると解釈した。
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第1行の最右列
For j = 2 To r 'sheet1のB列とsheet2の第1行で同じ列を探す
If sh2.Cells(1, j) = sh1.Cells(i, "B") Then 'Sheet2第1行とsheet1B列が等しいか
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のA列セット
r = sh2.Range("IV1").End(xlToLeft).Column 'sheet2第1行の最右列
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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) vbaのvlookup関数エラー原因を教えていただけないでしょうか。 3 2022/04/25 16:16
- Visual Basic(VBA) ExcelVBAでDo Until loopのネスト、IF文を使って一致する物と一致しない物としたい 11 2022/12/24 17:46
- Visual Basic(VBA) VBA 請求書自動作成 3 2022/04/24 01:58
- Visual Basic(VBA) VBAで、シート間の転記するコードをFOR~NEXTで教えてください。 9 2023/04/30 20:04
- Visual Basic(VBA) まとめシートから集計シートへA列のコードが一致したら1行コピーするマクロをネット上で見つけました。こ 1 2022/08/30 14:11
- Visual Basic(VBA) VBAで重複した値のセルに色付けをしたい 1 2022/11/02 16:12
- Visual Basic(VBA) Excelで下記のようにマクロを作ったところ、一回目は実行できたのですが、二回目以降「実行時エラー1 1 2022/03/25 08:08
- Visual Basic(VBA) Sheet1のA列にコードB列にメアド、Sheet2のB列にコード一覧とD列にメアド一覧があり、Sh 3 2022/10/19 11:57
- Visual Basic(VBA) フォルダの場所を可変にしたいです(マクロ) 4 2023/05/11 10:00
- Excel(エクセル) マクロで最終行から上に検索を逆にしたい 1 2022/05/17 18:27
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Worksheets メソッドは失敗しま...
-
Cellsのかっこの中はどっちが行...
-
vba 2つの条件が一致したら...
-
B列の最終行までA列をオート...
-
【VBA】2つのシートの値を比較...
-
Excelで、あるセルの値に応じて...
-
VBAを使って検索したセルをコピ...
-
rowsとcolsの意味
-
データグリッドビューの一番最...
-
エクセルVBAにて =A1=B1とすれ...
-
URLのリンク切れをマクロを使っ...
-
VBAで、特定の文字より後を削除...
-
マクロ 最終列をコピーして最終...
-
マクロ 関数を使った抽出でエラ...
-
EXCEL VBAマクロについて質問です
-
VBAコンボボックスで選択した値...
-
エクセルVBAでデータをカウント...
-
エクセルVBA シートモジュール...
-
VBAでのリスト不一致抽出について
-
最終列の右へSUM関数を作成する...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
B列の最終行までA列をオート...
-
vba 2つの条件が一致したら...
-
Cellsのかっこの中はどっちが行...
-
VBAを使って検索したセルをコピ...
-
VBAのFind関数で結合セルを検索...
-
文字列の結合を空白行まで実行
-
IIF関数の使い方
-
【VBA】2つのシートの値を比較...
-
マクロ 最終列をコピーして最終...
-
Changeイベントでの複数セルの...
-
VBA 何かしら文字が入っていたら
-
URLのリンク切れをマクロを使っ...
-
エクセルVBAにて =A1=B1とすれ...
-
VBAでのリスト不一致抽出について
-
データグリッドビューの一番最...
-
マクロについて。S列の途中から...
-
VBA UserFormからの転記で
-
targetをA列のセルに限定するに...
おすすめ情報