エクセルVBAで検索して内容をコピーする

VBAで検索をして内容コピーをするやり方を考えているのですが、
初心者でどうもうまくいきません。

処理の内容としては、
シート１のＡ列、Ｂ列とシート２のＡ列と一致したときに
シート２のＢ列にある内容を
シート１のＣ列にコピーするもの。（空白時は、とばして次の処理へ行く）

No.5 ベストアンサー 回答者： tom04 回答日時： 2011/06/19 20:22

こんばんは！

横からお邪魔します。

こういうことですかね？
各Sheetともデータは2行目からあるとします。
一例です。

Sub test()
Dim i, j As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range(ws1.Cells(i, 1), ws1.Cells(i, 2)), ws2.Cells(j, 1)) Then
ws1.Cells(i, 3) = ws2.Cells(j, 2)
End If
Next j
Next i
End Sub

外していたらごめんなさいね。m(_ _)m

この回答へのお礼

このVBAが使いやすいので参考にさせていただきます。
ありがとうございます

お礼日時：2011/06/19 22:00

No.4 回答者： imogasi 回答日時： 2011/06/19 19:48

>シート１のＡＢ列は、比較したデータが入っており、

存在するものは、項目が出てきて、ないものは項目が出てこないというデータです。
超えｒだって意味がよくわからない・。
ーー
あんまり自信ないが（下記コードで（Ａ）（Ｂ）の点など）
Sub test01()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d1 = sh1.Range("A65536").End(xlUp).Row
d2 = sh1.Range("B65536").End(xlUp).Row
d = IIf(d1 > d2, d1, d2) '下の方を取る（Ａ）
MsgBox d
For i = 1 To d
k = sh1.Cells(i, "A")
If sh1.Cells(i, "A") = "" Then k = sh1.Cells(i, "B") 'A列空白ならＢ列を使う（Ｂ）
MsgBox k
On Error GoTo p1
r = sh2.Range("a1:A100").Find(k).Row
MsgBox r
sh1.Cells(i, "C") = sh2.Cells(r, "B")
p2:
Next i
Exit Sub
p1:
Cells(i, "C") = "該当なし"
Resume p2
End Sub
結果
Ｓｈｅｅｔ１
Ａ列　　　　　Ｂ列　　　　Ｃ列
AAAAAAAAAA日本
BBBBBBBBBBアメリカ
CCCCC該当なし
DDDDD該当なし
EEEEE該当なし
FFFFFFFFFFエジプト
gggggインド
Ｓｈｅｅｔ２　検索表
AAAAA日本
BBBBBアメリカ
FFFFFエジプト
gggggインド

この回答へのお礼

このVBAも参考にさせていただきます。
ありがとうございます

お礼日時：2011/06/19 21:59

No.3 回答者： hallo-2007 回答日時： 2011/06/19 19:11

No1です。

関数案で
C列に　=VLOOKUP(IF(A2="",B2,A2),Sheet2!A:B,2,FALSE)
下コピーで十分です。

もしVBA　でというのであれば
マクロの記録で、上記の式を入れて下へコピー
C列を選択、コピー、形式を選択して貼り付け　値　にチェック　OK
までの一連の作業を記録してみてください。

この回答へのお礼

ありがとうございます
マクロでやりたいと思います

お礼日時：2011/06/19 21:56

No.2 回答者： keithin 回答日時： 2011/06/19 17:46

作成例：

sub macro1()
　dim h as range
　dim res as range
　worksheets("Sheet1").activate
　’目的の範囲を取得して巡回し
　for each h in range("A2:A" & range("A65536").end(xlup).row)
　’検索して
　　set res = worksheets("Sheet2").range("A:A").find(what:=h & h.offset(0, 1), lookin:=xlvalues, lookat:=xlwhole)
　　if not res is nothing then
　　’コピーする
　　　res.offset(0, 1).copy destination:=h.offset(0, 2)
　　end if
　next
end sub



＃既出回答でも指摘がある通り，シート１のＡＢ列を「どうした」のがシート２のＡ列と一致したらなのか，肝心のヤリタイ事が不明瞭です。

この回答への補足

失礼しました。
シート１のＡＢ列は、比較したデータが入っており、
存在するものは、項目が出てきて、ないものは項目が出てこないというデータです。


シート１エクセルの例　　　　　　　　　　　　シート２エクセル例
　A　　　　B　　　　　　　　　　　　　　　　　　　　　　Ａ　　　B
AAAAA　　AAAAA　　　　　　　　　　　　　　AAAAA　　日本
BBBBB　　BBBBB　　　　　　　　　　　　　　BBBBB　　アメリカ
CCCCC　　　　　　　　　　　　　　　　　　　　　　　・
　　　　　　　DDDDD　　　　　　　　　　　　　　　　・
EEEEE

補足日時：2011/06/19 18:22

No.1 回答者： hallo-2007 回答日時： 2011/06/19 16:07

>シート１のＡ列、Ｂ列とシート２のＡ列と一致したときに

A列とB列のふたつをどう一致した時でしょうか。
質問の内容を
シート１のＡ列とB列をつなげた値が
シート２のＡ列と一致した行のＢ列にある内容を
シート１のＣ列に表示
ということであれば
C列にVlookup関数をいれれば簡単にできます。