エクセルで日毎のデータの蓄積

質問

シートBにその日のデータを入力し、そのデータをシートAに蓄積していきたいです。

手作業ならば、
１．入力されたシートBのその日のデータをコピー
２．シートAの同じ日付の行を探し、値のみペースト
とするのでしょうが、これを自動化したいです。
セル参照だと、毎日、同じ行にデータが上書きされていくため
無理っぽいし、マクロを使わないとできませんか？

コピーとペーストはできそうですけど、「同じ日付の行を探し」というところが難しそうだなぁと思いました。。。

すみませんが、よろしくお願いします。

シートA（データ蓄積用）
日付　　　データ
12/1　　　データ1
12/2
・
・
12/31

シートB（データ入力用）
日付　　　データ
12/2　　　データ2
↑日付が変われば、同じ行にデータを上書き

回答No.1

papayuka · ベストアンサー

シート名「シートB」の シート名タブを右クリックして「コードの表示」
出てきたVBE画面にコピペします。

シートB の B2セルに書き込みをするとシート名「シートA」に書き込みをします。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim r, tr As Range
Set tr = Target.Cells(1, 1)
If tr.Address = "$B$2" Then
　 With Worksheets("シートA")
　 Set r = .Range("A:A").Find(tr.Offset(0, -1).Value, _
　　　　　　　　.Range("A65536"), xlFormulas, xlWhole)
　　　　If r Is Nothing Then
　　　　　 .Range("A65536").End(xlUp).Offset(1, 0).Value = tr.Offset(0, -1).Text
　　　　　 .Range("B65536").End(xlUp).Offset(1, 0).Value = tr.Value
　　　　Else
　　　　　 r.Offset(0, 1).Value = tr.Value
　　　　End If
　 End With
End If
End Sub

お礼

ありがとうございます。
Findを使って該当セルを探すのですね。
流れはわかりました。
もうちょっと勉強してみます。

今回は早速のご回答ありがとうございました。

回答No.2

zap35

ブックを保存する前に当日のデータ（データ2）をデータ蓄積用シートに書き込むようにしました。
マクロ中のシート名は実際の名前に変更してください（質問にあるとおりのシートA、シートBとしています）。また当日分のデータが書かれているセルアドレスがB2以外であれば、これも３行目を変更してください

なお、データ蓄積用シートの日付はA列、データはB列としてマクロを書きました。違うのであれば補足してください。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim RES
Const Adr As String = "B2" '←　当日のデータのセルアドレス
With Worksheets("シートB")
　RES = Application.Match(.Range(Adr).Offset(0, -1).Value * 1, _
　　　　　Worksheets("シートA").Range("A1:A10000"), 0)
　If IsError(RES) Then
　　MsgBox ("合致する日付が見つからないため" & Chr(13) & _
　　　　　　 "本日のデータは書き込みできません")
　Else
　　Worksheets("シートA").Cells(RES, "B") = .Range(Adr).Value
　End If
End With
End Sub

マクロはALT＋F11でVBE画面を開き、「VBAProjectエクスプローラ」の「ThisWorkBookを右クリック」→「コードの表示」で表示される画面にペーストして下さい。ブック保存時に自動実行されます。

お礼

丁寧なご回答ありがとうございました。
No.1さんのFindに対し、Matchを使うのですね。
参考にさせていただきます。
ありがとうございました。