こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

エクセル2000です。

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

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

投稿日時 - 2004-12-02 18:13:48

QNo.1109665

困ってます

質問者が選んだベストアンサー

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

あと、表Aは165行ですか?170なんですか?
とりあえずは165でやっておきましたが。

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

投稿日時 - 2004-12-02 18:49:05

お礼

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

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

投稿日時 - 2004-12-04 20:23:54

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

ほんと分かりづらいです。読んでも一回では頭に入らない。
表現を変えると
表A(SheetA)
C列  コード
D列  本件のVBAでセット

表B(SheetB)
A列  コード
B列  数
表Aのコードを見て、表Bで同じコードを探し、見つかれば表BのB列の数を持って来てセットする。
表BのA列コードはユニーク(ダブリなし)とする。
Findメソッドを使えば良いと思います。
Sheet3
C1:C3に(D列は結果も載せたもの)(表Aに当たる)
C列   D列
d9950
h8975
s
g8900
x

Sheet1のA1:B5に(表Bに当たる)
A列   B列
a50
d9950
f200
g8900
h8975

VBA
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
(結果)
上記Sheet3のD列のとおり。

投稿日時 - 2004-12-02 23:23:48

補足

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

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

に変えただけですが。

投稿日時 - 2004-12-04 20:30:05

お礼

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

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

投稿日時 - 2004-12-04 20:29:15

あなたにオススメの質問