都道府県穴埋めゲーム

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


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

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

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

A 回答 (4件)

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
    • good
    • 2
この回答へのお礼

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

お礼日時:2005/01/21 10:36

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



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

などです。

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

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

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

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

一番確実なのは、


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

ベタに作ってみました。


'-------------------↓↓↓
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
'-------------------↑↑↑
    • good
    • 0
この回答へのお礼

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

お礼日時:2005/01/21 10:27

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


おすすめ情報