VBAを使ってセルを検索後別シートのデータを自動入力したいです。

質問

見ていただきありがとうございます。

エクセルの2000VBAを使って次のようなことを考えています。

シート2に以下のようなデータがあります。

2006/7/20
コード　数量
　100　　200　
　200　　400

データの数は日によって違います。

シート1には以下の表があります。横軸にはコード縦軸には日付が入っており各対応するセルに数量が入っています。

　　　　　　100　　200　　300　　400　....←コード
2006/7/1　　20　　40　　100　　800
2006/7/2　　50　　60　　200　　500
　　.
　　.
　　.
2007/6/30　

このような場合、シート2にコマンドボタンを設けて押したときシート2の日付とコード番号によりシート1の表の検索を行って対応するセルにシート2のデータを転記したいのです。シート2のデータは本日分のデータが入った時点でシート1への転記を行います。（1日一回です）
また、シート1の表は2007/6/30（これ以降は必要ないので）までの日付がすでに入力されており明日以降のデータの入るセルは空白になっております。

よろしくお願いします。

回答No.5

zap35 · ベストアンサー

＞sheet1のコードがが2行目に記入されている場合は
　For idxR = LastR To 3 Step -1　を
　For idxR = LastR To 2 Step -1　にします。

でもそうすると検索する日付はどこに行くのですか？
　trgR = Application.Match(.Cells(1, 1), Worksheets("Sheet1").Range("A:A"), 0)
のCells(1,1)でA1の内容を参照しますので、この部分も変更しないとダメですね。日付が入っているセルに変更して下さい。Cells(行番号、列番号)です。

お礼

詳しくご親切に教えていただいて有難うございました。
おかげさまで助かりました。
丸投げになってしまい申し訳ありませんでした。

回答No.4

NCU

> シート1の表は2007/6/30（これ以降は必要ないので）までの日付がすでに入力されており明日以降のデータの入るセルは空白になっております。

それならデータテーブルが早いのでは？
転記しなくてもリアルタイムで反映しますが。
丸投げ勘違いさんには理解できないかもしれませんが。

回答No.3

zap35

＃０１です
＞Sheet2のコードが赤色に反転して
とのことですが、もし全てのコードが赤色に着色されたなら、Sheet2のA1セルに入力した日付と、Sheet1のＡ列に入力した日付の形式（タイプ）が異なっている可能性があります。形式を合わせてください。

例）Sheet1は2006/7/1と手入力し、Sheet2は　=NOW()で入力し書式を　yyyy/m/ddとしている

それを検証するためマクロを一部変えました。もし日付の検索でエラーとなる場合はコードではなく日付が着色されるはずです。（Sheet1の日付がどのように入力されたかがわかればマクロでも対応できるのですが、それがわからないので確認までしかできません）

Sub Macro1()
Dim LastR, idxR As Long, trgR, trgC
With Worksheets("Sheet2")
LastR = .Range("A65536").End(xlUp).Row
trgR = Application.Match(.Cells(1, 1), Worksheets("Sheet1").Range("A:A"), 0)
If IsNumeric(trgR) Then
For idxR = LastR To 3 Step -1
trgC = Application.Match(.Cells(idxR, 1), Worksheets("Sheet1").Range("1:1"), 0)
If IsNumeric(trgR) And IsNumeric(trgC) Then
Worksheets("Sheet1").Cells(trgR, trgC) = .Cells(idxR, 2)
Else
.Cells(idxR, 1).Interior.ColorIndex = 3
End If
Next idxR
Else
.Cells(1, 1).Interior.ColorIndex = 3
End If
End With
End Sub

＞それとSheet1の1行目はB列からにしましたがよかったでしょうか？
　はい。コードはＢ列からが正しいです。

補足

有難うございました。同じシートにて今回の新しいマクロを入れたところうまくいきました。日付等一切変えてないのですがどこがいけないのか私には分かりません。でもうまくいきました。

後、もうひとつ教えていただきたいのですが、sheet1のコードがが2行目に記入されている場合はマクロのどこを変更すればよいのでしょうか？すいませんがお願いします。
当方整理されたマクロはかえって分からなくなってしまい、ちんぷんかんぷんです。

回答No.2

KenKen_SP

VBA ではないです。

例）

日付　　　　コード　　数量
2006/7/20　　A100　　200
2006/7/20　　A200　　400
2006/7/20　　A300　　10
2006/7/20　　B100　　5
2006/7/21　　E100　　300
2006/7/22　　A100　　50
2006/7/22　　A300　　15
2006/7/22　　B200　　150
2006/7/22　　B300　　500

こんな感じでデータは日々蓄積し、マトリクス（下図）がほしければ
ピボットテーブルで...ってのはダメですか？

　　　　　　　A100　　A200　　A300　....　E100
2006/ 7/20　　 200　　 400　　　10　....
2006/ 7/21　　　　　　　　　　　　　　　　300
・
・

[データ]メニューにあるピボットテーブルをクリックして、ウィザード
を起動し、3/3 のページで[レイアウト]ボタンを押し下記のように項目
をドロップするだけです。

列の枠：　日付
行の枠：　コード
データ：　数量

お礼

有難うございました。
当方、マクロにて行いたいのでzap35さんのほうで行いたいと思います。
またよろしくお願いします。

回答No.1

zap35

Sheet2という名前のシートが
　　　　Ａ列　　　　Ｂ列
１行目　2006/7/5
２行目　コード　　　数量
３行目　　100　　　　200

Sheet1という名前のシートが
　　　　Ａ列　　　Ｂ列　　　Ｃ列　　　Ｄ列　…
１行目　100　　　　200　　　300　　　400
２行目　2006/7/1　　20　　　40　　　　100
３行目　2006/7/2　　50　　　60　　　　200　

のセル配置の時、

Sub Macro1()
Dim LastR, idxR As Long, trgR, trgC
　With Worksheets("Sheet2")
　　LastR = .Range("A65536").End(xlUp).Row
　　trgR = Application.Match(.Cells(1, 1), Worksheets("Sheet1").Range("A:A"), 0)
　　For idxR = LastR To 3 Step -1
　　　trgC = Application.Match(.Cells(idxR, 1), Worksheets("Sheet1").Range("1:1"), 0)
　　　If IsNumeric(trgR) And IsNumeric(trgC) Then
　　　　Worksheets("Sheet1").Cells(trgR, trgC) = .Cells(idxR, 2)
　　　Else
　　　　.Cells(idxR, 1).Interior.ColorIndex = 3
　　　End If
　　Next idxR
　End With
End Sub

なおコードが合致しないときはSheet2のセルの色を変えています。

補足

早々に回答を頂きありがとうございます。

例にならってsheet1とSheet2を作成してSheet2にコマンドボタンを作成して実行してみたところ、Sheet2のコードが赤色に反転してsheet1に転記できませんでした。どこがいけないのでしょうか？

それとSheet1の1行目はB列からにしましたがよかったでしょうか？
　　　　Ａ列　　　Ｂ列　　　Ｃ列　　　Ｄ列　…
１行目　100⇒⇒⇒100　　　200　　　 300　　　400
２行目　2006/7/1　　20　　　40　　　　100
３行目　2006/7/2　　50　　　60　　　　200　

よろしくお願いします。