Excelで、別シートへの条件付コピー（入出荷データを在庫データへ）

質問

こんにちは。Access使いからすると朝飯前の内容かもしれません、、

以下ような内容のリレーショナルをExcelにて行う方法をご存知でしたら教えてください。

テーマ：PC入出庫データを都度資産データへ反映
＜例＞
1.入力
入出庫データ（シート名：In_out）
　　　A　　　 ｜B　 ｜C ｜D
　　　資産番号｜日付｜status｜User Code
10 　　００１ ｜1/1 ｜設置 ｜ABC
＊
＊
300　 ００１　｜3/31｜回収　｜ABC

2.反映
資産データ（シート名：master）
上記「入力」の10行目が入力されると

　　　A　　　 ｜B　 ｜C ｜D
　　　資産番号｜日付｜status｜User Code
＊
＊
100　　００１ ｜1/1 ｜設置 ｜ABC

300行目が入力されると

　　　A　　　 ｜B　 ｜C ｜D
　　　資産番号｜日付｜status｜User Code
＊
＊
100　　００１ ｜3/31｜回収 ｜ABC

となるように、
入出庫データ（シート名：In_out）
を入力した時点で　資産シート（Master）の
資産番号が一致するものを検索して、In_outの列BCD
値を　Msasterの列BCDへ反映したいのです。
データは入出庫：１万件　資産：三千件程度です

識者の方の知恵がお借りできれば幸いです。
Accessへ乗り換える予定ですが、開発までやや時間がかかるので（来年２月）その間に、手入力でコピペするのも非効率なので、マクロまたは関数で解決できないものかと思い、質問させていただきました。
よろしくお願いします。
ちなみに、Excel2003です。

回答No.2

papayuka · ベストアンサー

こんなイメージかな？

１．データはシート名 In_out に入力して行く
２．シート名 In_out の最終行のみ更新対象とする（途中行のデータを変えても処理しない）
３．シート名 In_out のA列最終セル値をシート名 master のA列から探し、見つかった場合は上書き、見つからない場合は追加する。

Sub Test()
Dim r As Range, tr As Range, myRow

With Worksheets("master")
　Set r = Worksheets("In_out").Range("A65536").End(xlUp)
　On Error GoTo ER:
　myRow = Application.WorksheetFunction.Match(r.Value, .Columns(1), 0)
　Set tr = .Range("A" & myRow)
　If MsgBox("マスターシートの " & myRow & "行目に転記します。" & _
　　 vbCrLf & "よろしいですか？", vbExclamation + vbOKCancel, _
　　 "データ修正") <> vbOK Then Exit Sub
　r.Offset(0, 1).Resize(1, 4).Copy _
　　　　　　Destination:=tr.Offset(0, 1).Resize(1, 4)
End With
　Exit Sub
ER:
　If MsgBox("新規データですのでマスターシートに追加しますか？", _
　　　　　vbQuestion + vbYesNo, "データ追加") <> vbYes Then Exit Sub
　Set tr = Worksheets("master").Range("A65536").End(xlUp).Offset(1, 0)
　r.Resize(1, 5).Copy Destination:=tr.Resize(1, 5)
End Sub

あまりスマートじゃないけど。

お礼

ご返答ありがとうございます。結果的に以下のシートモジュールでできました。
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim tSh As Worksheet
Dim fRng As Range
Dim fR As Range
With Target
If .Cells.Count > 1 Then Exit Sub
If Intersect(.Cells, Range("D2:D65536")) Is Nothing Then Exit Sub
Set tSh = Worksheets("master")
With tSh
Set fRng = .Range("A2", .Range("A65536").End(xlUp))
End With
Set fR = fRng.Find(.Offset(, -3).Value, , xlFormulas, xlWhole)
If fR Is Nothing Then
MsgBox "該当番号が見つかりません。"
Exit Sub
End If
If fR.Offset(, 1).Value2 > .Offset(, -2).Value2 Then
MsgBox "最新データでは有りません。"
Exit Sub
End If
fR(1, 2).Resize(, 3).Value = .Offset(, -2).Resize(, 3).Value
End With
End Sub

回答No.1

papayuka

例では資産番号がダブってる(001)けど、ユニークじゃないと特定出来ないですね。

「資産シート」データを選択し、データ－フォームでフォームを開いて検索条件で資産番号を検索して直接「資産シート」に入力するのは？

お礼

ご返答ありがとうございます。
＞資産番号がダブってる(001)けど、ユニークじゃないと
ご指摘の通りですが、今のところ、
in_outは重複OKです
（日付とセットで、ユニークにしています）
master　はユニークです
in_out：Master　＝　n：1
です