エクセルマクロ　日付を検索し入力

解決済

質問者：su-hi
質問日時：2009/05/26 18:02
回答数：2件

エクセル2003マクロを使用して以下の事を行いたいと思っていますが、どのようなマクロを組んだらよいか分かりません。よろしくお願いします。
シート上部にある以下のデータを
　　 A 　　　 B 　　　　C 　　　　D 　　　　E 　　
1　日付　商品A 商品B　商品C 　商品D
2　 5/26 　　 5 　　　 6 　　　 1 　　　　 3 　　 ←その日のデータ（毎日変わる）
入力ボタンを作成し、それを押すことにより
　　　　　　　↓
6 　　5/1
7 　　・
8　　　・
9 　 5/26　　　5　　　　 6　　　　1　　　　　3
10　　・
　↑日付が予め入力された表
上記のような、同一シート上の日付欄に入力される表を作りたいのですが、方法が分かりません。
その日のデータは、別シートに入力用フォームを作成し、飛ばしています。何人かの人間が入力するので、マクロで簡単に、行えるようにしたいと思います。よろしくお願いします。

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (2件)

ベストアンサー優先
最新から表示
回答順に表示

No.2ベストアンサー

回答者： fujillin
回答日時：2009/05/26 19:24

不明な部分が多すぎだけど、適当に推測で作成しています。

適宜修正してください。

仮定条件
・入力行は1行のみ
・集計用のシートの日付欄には重複がない
・入力データの日付と集計シートの日付は同じ形式の値
　（Dateシリアル　または　文字列など）
・集計シートに日付が存在しない場合は、最終行に追記
・入力データはコピーしても良い（書式がコピーされる）

その他、#1様の疑問など運用面での条件なども不明ですが参考までに。
Sub test()
Dim stS As Worksheet, stD As Worksheet, dt
Dim rw As Long, r As Long, r0 As Long, rg As String

Const stsorce = "Sheet1" '←入力データのあるシート名"
Const stdest = "Sheet2" '←集計用シートのシート名
Const rng = "A2:E2" '←入力データの範囲1行（一番左が日付）

Set stS = Worksheets(stsorce)
Set stD = Worksheets(stdest)

rg = Range(rng).Rows(1).Address
dt = stS.Range(rg).Cells(1, 1).Value
If dt <> "" Then
　rw = stD.Cells(Rows.Count, 1).End(xlUp).Row
　r0 = 0
　For r = 1 To rw
　　If stD.Cells(r, 1).Value = dt Then r0 = r: Exit For
　Next r
　If r0 = 0 Then r0 = rw + 1
　rw = stS.Range(rg).Row
　stS.Range(rg).Copy stD.Range(rg).Offset(r0 - rw)
End If
End Sub

この回答への補足

丁寧な回答をいただき、ありがとうございました。さっそく入力を行ったところスムーズな入力が出来、感動しました。
しかし、再度見直したところ、初めの私の質問に不備があり、運用として以下のように出来ればと思います。

　　 A 　　　 B 　　　　C 　　　　D 　　　　E 　　
1　日付　商品A 商品B　商品C 　商品D
2　 5/26 　　 5 　　　　　　 1 　　　　　　 ←その日のデータ（毎日変わる）
3 　5/26 　　　　　　 6　　　　　　　　　　　3　　←上と同日で入力する商品が違う。
入力ボタンを作成し、それを押すことにより
　　　　　　　↓
6 　　5/1
7 　　・
8　　　・
9 　 5/26　　　5　　　　 6　　　　1　　　　　3
10　　・
　↑日付が予め入力された表
と言う感じで、例えばAさんが始めに商品Aと商品Cを入力し、それが、入力ボタンで上記例の9行目に反映され、
その後Bさんが商品Bと商品Dを入力しても、初めにAさんが入力したデータは消えずに、集計用の表の同じ日に収まる
と言う感じに出来ればと思います。fujillinさんの仮定条件の「入力行は1行のみ」と言う部分のみ変える方法は、
どのように行ったらよいでしょうか。よろしければ教えてください。