エクセルマクロでデータの検索と転記方法

質問

エクセル2000です。

sheetAの　１０行～１６５行に表Aがあります。
途中に、空白行や小計行もかなりあります。
C列のコード（文字列、数値両方あります）をキーにして、SheetBの4行目から91行目までの表B（A列にコードがあります）のB列の数値を、sheetAの１０行～１７０行のD列に転記したいのです。sheetAの表の小計行のC列は空白です。SheetBの表Bのコードは、sheetAの表Aのコードの一部しかありません。ですから、sheetAの表AのコードがSheetBの表Bになかったらそこは何も転記しません。

わかりづらい説明かと思いますが、マクロの記述をお教えいただければ幸いです。

回答No.1

shishishishi · ベストアンサー

ほかにもっと良い方法があるはずですが、お困りならこんな感じでもできますね。ただし、このやり方だと少し時間がかかります。といっても数秒のことですが。

あと、表Aは１６５行ですか？１７０なんですか？
とりあえずは１６５でやっておきましたが。

Sub test01()
Set sh1 = Sheets("SheetB")
Set sh2 = Sheets("SheetA")
For n = 10 To 165
For i = 4 To 91
If sh2.Cells(n, 3) <> "" Then
If sh2.Cells(n, 3).Text = sh1.Cells(i, 1).Text Then sh2.Cells(n, 4) = sh1.Cells(i, 2)
End If
Next i
Next n
End Sub

お礼

少し時間がかかりますというのは、表Ａのコードを一つ一つ表Ｂの各行総当りで調べてるからですね？
でも数秒のことですからぜんぜん問題ないです。

いつもありがとうございます♪

回答No.2

imogasi

ほんと分かりづらいです。読んでも一回では頭に入らない。
表現を変えると
表Ａ（ＳｈｅｅｔＡ）
Ｃ列　　コード
Ｄ列　　本件のＶＢＡでセット

表Ｂ（ＳｈｅｅｔＢ）
Ａ列　　コード
Ｂ列　　数
表Ａのコードを見て、表Ｂで同じコードを探し、見つかれば表ＢのＢ列の数を持って来てセットする。
表ＢのＡ列コードはユニーク（ダブリなし）とする。
Ｆｉｎｄメソッドを使えば良いと思います。
Ｓｈｅｅｔ３
Ｃ１：Ｃ３に（Ｄ列は結果も載せたもの）（表Ａに当たる）
Ｃ列　　　Ｄ列
d 9950
h 8975
s
g 8900
x

Ｓｈｅｅｔ１のＡ１：Ｂ５に（表Ｂに当たる）
Ａ列　　　Ｂ列
a 50
d 9950
f 200
g 8900
h 8975

ＶＢＡ
Sub Macro3()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet3")
Set sh2 = Worksheets("sheet1")
d = 5
For i = 1 To d
Set x = sh2.Cells.Find(What:=sh1.Cells(i, "C"), After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If x Is Nothing Then GoTo p01
sh1.Cells(i, "D") = x.Offset(0, 1)
p01:
Next i
End Sub
（結果）
上記Ｓｈｅｅｔ３のＤ列のとおり。

お礼

わかりずらい質問に回答していただき、本当にありがとうございます。

こちらの方法は検索して調べるのですね？
勉強になりました。

補足

すみません。もう一つ教えてください。

Sub Macro4()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet3")
Set sh2 = Worksheets("sheet1")
d = 5
For i = 1 To d
Set x = sh2.Cells.Find(What:=sh1.Cells(i, "C"), After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not x Is Nothing Then sh1.Cells(i, "D") = x.Offset(0, 1)
Next i
End Sub

でも同じですか？
If x Is Nothing Then GoTo p01
sh1.Cells(i, "D") = x.Offset(0, 1)
p01:
Next i

を

If Not x Is Nothing Then sh1.Cells(i, "D") = x.Offset(0, 1)
Next i

に変えただけですが。