VBA シート①に日付とクレーム内容を記入すると、シート②にその累計を反映させる方法

業務であるリポートを管理しています。デイリーリポートなのでオートメーション化したいと考えています。やりたい事は以下です。

１つのファイル内に2つのシートがあります。
シート①　入電リポート
日付、入電内容、もしクレームだったら、クレーム列にクレームを入力

シート②　入電リポートの累計
日別に新しい列を作成しシート①の合計と累計をだしています。
日毎に摘出するデータ
・デイリー入電数
・これまでの入電数の累計
・デイリークレーム数
・これまでのクレーム数を累計

シート①を入力すると、オートでシート②で新しい列を作り、各日にちの統計データを計算し
表示させたいのです。

今は日付で結び付け、クレーム数は関数を使用してCOUNTをしています。毎回新しい日にちのデータをシート①に入力後、シート②で列を挿入、オートフィルでデータのアップデートをしています。
データをリンクできるのはネットで調べたのですが、少し意図が違うような気がしました。
オリジナルのプランでは、入力した日数をMSGウィンドウから入れて
loopでその日数まで列作成、データの反映。。。ですが、いまいちのような。
この部分をシート①入力でオート反映させる方法ありますか？

VBAに強い方、提案やアドバイスを頂ければ幸いです。
どうぞ宜しくお願いします！

質問者からの補足コメント

• ”データをリンクできるのはネットで調べた。。”を含め、勉強、調査をしています。
  教えてさんのサイトを活用し、知識のある人からの意見を聞くのも勉強の一部だと思い、ここで投稿したまでです。

    補足日時：2018/06/24 17:10

No.1 回答者： lv4u 回答日時： 2018/06/24 16:37

ＶＢＡのプログラムの本を読んで勉強したらいいと思いますが・・・。

No.2 ベストアンサー 回答者： tom04 回答日時： 2018/06/24 18:54

＞シート①入力でオート反映させる方法ありますか？

一例です。
元データの配置が判らないので、
↓の画像のように元データはSheet1のA・B列に上から順に入力していくとします。
これを右側のような表にするようにしてみました。

↓のコードをSheet1のシートモジュールにしてください。

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim myRow As Long, myCol As Long
　Dim c As Range, r As Range, wS As Worksheet
　　Set wS = Worksheets("Sheet2")
　　　If Intersect(Target, Range("A:B")) Is Nothing Or Target.Count > 1 Then Exit Sub
　　　　With Target
　　　　　If .Row > 1 And .Column <= 2 Then
　　　　　　If WorksheetFunction.CountA(Cells(.Row, "A").Resize(, 2)) = 2 Then
　　　　　　　Set c = wS.Range("A:A").Find(what:=Cells(.Row, "B"), LookIn:=xlValues, lookat:=xlWhole)
　　　　　　　　If c Is Nothing Then
　　　　　　　　　myRow = wS.Cells(Rows.Count, "A").End(xlUp).Row + 1
　　　　　　　　　wS.Cells(myRow, "A") = Cells(.Row, "B")
　　　　　　　　Else
　　　　　　　　　myRow = c.Row
　　　　　　　　End If
　　　　　　　Set r = wS.Rows(1).Find(what:=DateValue(Cells(.Row, "A")), LookIn:=xlFormulas, lookat:=xlWhole)
　　　　　　　　If r Is Nothing Then
　　　　　　　　　myCol = wS.Cells(1, Columns.Count).End(xlToLeft).Column + 1
　　　　　　　　　wS.Cells(1, myCol).NumberFormatLocal = Cells(.Row, "A").NumberFormatLocal
　　　　　　　　　wS.Cells(1, myCol) = Cells(.Row, "A")
　　　　　　　　Else
　　　　　　　　　myCol = r.Column
　　　　　　　　End If
　　　　　　　With wS.Cells(myRow, myCol)
　　　　　　　　.Value = .Value + 1
　　　　　　　End With
　　　　　　End If
　　　　　End If
　　　　End With
End Sub

※　コード内の「Sheet2」のシート名は実際のシート名にしてください。m(_ _)m

この回答へのお礼

わかりやすく画像もつけて頂き、ありがとうごさいました！
Worksheet_Change(ByVal Target As Range)とIf Intersect(Target, Range("A:B")) Is Nothingがとても参考になりました。

お礼日時：2018/06/26 19:54