エクセル VBA データのマッチング

質問

エクセルのＶＢで下記のプログラムの作成をしたいのですがうまくマクロが組めません。

ファイル名：TEST01.XLS
ファイル名：TEST02.XLS

があります。
TEST01.XLSにあるＡ列のデータ、TEST02.XLSにＧ列にあるデータが一致した場合のみ、一致した行にあるTEST01.XLSのＢ列にある４桁のコードを一致したTEST02.XLSのＬ列に表示させるプログラムを作りたいです。

すみませんが回等お願いできませんか。

回答No.2

error123 · ベストアンサー

TEST01のA列とTEST02のG列が全て一致したらじゃないですよね？
TEST01のA列にあるデータと同じものがTEST02のG列のどこかの行にあれば、TEST02のL列にTEST01のB列の値をひっぱってくればいいんですよね？

二つのファイルともデータはSheet1にあるものとしてマクロを書いてみました。

両方のファイルを開いてから実行してくださいね。

Sub TEST01()
Set d1 = Workbooks("TEST01.xls").Sheets("Sheet1")
Set d2 = Workbooks("TEST02.xls").Sheets("Sheet1")
R = d2.Cells(65536, "G").End(xlUp).Row
For i = 1 To R
Set x = d1.Columns("A").Find(What:=d2.Cells(i, "G"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not x Is Nothing Then
d2.Cells(i, "L") = x.Offset(0, 1)
End If
Next i
End Sub

お礼

感激です。うまく走りました。

回答No.4

KenKen_SP

マッチングやその前提となる条件を示した方が良いかと思います。

1.　完全一致？部分一致？
2.　比較するのは数値？文字列？
3.　全角・半角・大文字・小文字の区別は？

などです。

、、と、ここまで言ってなんなんですが、ご質問文から読み取る限り、普通にVLOOKUP関数でいける気がします。

例えば、TEST02.XLSのL1セルに
=VLOOKUP(G1,[TEST01]Sheet1!$A:$B,2,FALSE)

理由があって、VBAで行う必要があるのですか？
VBAでやるにせよ、難しく考えず、VBAでVLookupワークシート関数を使い、返された値を書き込む処理をループさせるだけで良いと思います。

勘違いでしたら、申し訳ありません。

回答No.3

imogasi

一番確実なのは、
TEST01.XLS　はA列で
TEST02.XLS　はG列で
昇順にソートします。
あとはマッチングのロジックで比較して一致した時だけ
０１のB列を０２にもっていけば良い。
「マッチングのロジック」が判らなければ、情報処理の受験参考書やコボルの本によく載っています。
ソートは自分で自作するのも面倒で、エクセルに読みこませてやるか、DOSのSORTコマンドを使うことになるのかなと思います。

回答No.1

toshiman

ベタに作ってみました。
'-------------------↓↓↓
Sub MacroSample()

'EXCELブック TEST01,TEST02は開いておくこと
Set xlWB_TEST01 = Workbooks("TEST01.xls")
Set xlWB_TEST02 = Workbooks("TEST02.xls")

blnMatch = True
For I = 1 To xlWB_TEST01.Sheets(1)_
.Range("A:A").End(xlDown).Row
'A列の最下行まで
'TEST01のA列の値とTEST02のG列の値が一致しているか調べる
If xlWB_TEST01.Sheets(1).Cells(I, 1).Value <> _
xlWB_TEST02.Sheets(1).Cells(I, 7).Value Then
blnMatch = False
Exit For
End If
Next I

If blnMatch Then
'一致していた場合
For I = 1 To xlWB_TEST01.Sheets(1).Range("A:A").End(xlDown).Row
'TEST01のB列の値をTEST01のL列にセット
xlWB_TEST02.Sheets(1).Cells(I, 12).Value _
= xlWB_TEST01.Sheets(1).Cells(I, 2).Value
Next I
End If

End Sub
'-------------------↑↑↑

お礼

すみません。コピペしてもマクロがうまく走りませんでした。