Excel VBA 集計ﾏｸﾛについて

異常項目別で発生回数と発生時間の合計時間の集計したいです。
異常発生時間は日付をまたぐ時もあるので日付をまたいだ時も計算できるようにしたいです。
ﾃﾞｰﾀ量が多いため困っています。
内容は
”Data”ｼｰﾄに
・B欄に”異常内容”
・C欄に”開始日付時刻”
・D欄に”終了日付時刻”
のﾃﾞｰﾀがあり黄色塗潰し範囲のG2:J3の設定値のを設定後
ﾏｸﾛを起動すれば
”集計”ｼｰﾄに
F6：H10のような結果表を出るようにしたいです。

分かる方いらっしゃいましたらご教授下さい。
お手数おかけしますがお願いします。

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

• 説明が抜けてました。
  B欄の異常内容は種類が無限大にあるため一緒に集計したいです！
  決まった内容が出てくるわけではないです。

    補足日時：2020/07/04 14:28

No.2 ベストアンサー 回答者： tom04 回答日時： 2020/07/04 15:06

こんにちは！

一例です。
↓の画像のような配置だとします。
標準モジュールにしてください。

「集計」シートのC列表示形式は
[h]:mm
にしておいてください。

Sub Sample1()
　Dim i As Long, lastRow As Long
　Dim wS As Worksheet
　Dim c As Range
　Dim myTime, myStart, myEnd

　　Set wS = Worksheets("Data")
　　　With Worksheets("集計")
　　　　'//▼データを一旦消去//
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　If lastRow > 1 Then
　　　　　　Range(.Cells(2, "A"), .Cells(lastRow, "C")).ClearContents
　　　　　End If
　　　　'//▼ココから操作//
　　　　myStart = DateSerial(wS.Range("G2"), wS.Range("H2"), wS.Range("I2")) + wS.Range("J2")
　　　　myEnd = DateSerial(wS.Range("G3"), wS.Range("H3"), wS.Range("I3")) + wS.Range("J3")
　　　　　For i = 2 To wS.Cells(Rows.Count, "B").End(xlUp).Row
　　　　　　If wS.Cells(i, "C") >= myStart And wS.Cells(i, "D") <= myEnd Then
　　　　　　　myTime = wS.Cells(i, "D") - wS.Cells(i, "C")
　　　　　　　　Set c = .Range("A:A").Find(what:=wS.Cells(i, "B"), LookIn:=xlValues, lookat:=xlWhole)
　　　　　　　　　If c Is Nothing Then
　　　　　　　　　　With .Cells(Rows.Count, "A").End(xlUp).Offset(1)
　　　　　　　　　　　.Value = wS.Cells(i, "B")
　　　　　　　　　　　.Offset(, 1) = 1
　　　　　　　　　　　.Offset(, 2) = myTime
　　　　　　　　　　End With
　　　　　　　　　Else
　　　　　　　　　　With .Cells(c.Row, "B")
　　　　　　　　　　　.Value = .Value + 1
　　　　　　　　　　　.Offset(, 1) = .Offset(, 1) + myTime
　　　　　　　　　　End With
　　　　　　　　　End If
　　　　　　End If
　　　　　Next i
　　　　　　.Activate
　　　End With
　　　　MsgBox "完了"
End Sub

※　結果はお示しのようなデータにならないのですが、
的外れならごめんなさい。m(_ _)m

この回答へのお礼

回答ありがとうございます。
無時に目的通りのﾃﾞｰﾀが集計できました。
ありがとうございました！！

お礼日時：2020/07/04 18:23

No.6 回答者： Qchan1962 回答日時： 2020/07/04 18:12

#4です。

ごめんなさい。訂正します。
　　　　startDate = CDate(.Range("G2") & "/" & .Range("H2") & "/" & .Range("I2") & " " & .Range("J2").Text)
　　　　endDate = CDate(.Range("G3") & "/" & .Range("H3") & "/" & .Range("I3") & " " & .Range("J3").Text)
これ、ループの中に入れてください。

　　　　For i = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
　　　　　startDate = CDate(.Range("G2") & "/" & .Range("H2") & "/" & .Range("I2") & " " & .Range("J2").Text)
　　　　　endDate = CDate(.Range("G3") & "/" & .Range("H3") & "/" & .Range("I3") & " " & .Range("J3").Text)
　　　　　If .Cells(i, "C") < endDate Or .Cells(i, "D") > startDate Then

ちゃんと変数作ればよかった、、すみません。

この回答へのお礼

丁寧に訂正までありがとうございます。
一回ｴﾗｰ処理など修正してみます。
いつもありがとうございます。

お礼日時：2020/07/04 18:37

No.5 回答者： ママチャリ 回答日時： 2020/07/04 18:01

直接の回答で無くて申し訳ないのですが・・・。

抽出条件って、次のいずれになりますか？
①開始時刻が集計開始日時～集計終了日時の間にあるデータ
②終了時刻が集計開始日時～集計終了日時の間にあるデータ
③上記①または②のデータ（何れかが範囲内であるという意味）
④開始時刻、終了時刻が、ともに集計開始日時～集計終了日時の間にあるデータ

集計開始日時、集計終了日時の年、月、日、時刻が別々のセルになっている理由は？
（なぜ、開始時刻のように、1セルに入力していないのか？※そうなっていた方が実装が簡単）

「急いでます！！」とのことですが、これは、マクロを作ることを急いでいる？
それとも、結果を出すことですか？
結果を出すだけなら、マニュアル操作の方が早いですよ。

以下、マニュアル操作で行う場合のヒントです。
（同じ内容をマクロで書くことも可能なので、挑戦してみて下さい）

①オートフィルタやフィルタオプションを使って対象行を抽出し、作業用シートにコピーする。
②開始時刻をコピーして、終了時刻にコピーする。その際、「形式を指定して貼り付け」で。演算（減算）を指定して、差の時間を求める。
③上記の結果をもとに「統合」機能で「異常内容」別に集計すれば出来上がり。

この回答へのお礼

回答ありがとうございます。
別々のｾﾙのが入力しやすいと思い、ｾﾙを別々にしました。
作成ﾋﾝﾄまでありがとうございます。
参考にしてみます
ありがとうございました。

お礼日時：2020/07/04 18:35

No.4 回答者： Qchan1962 回答日時： 2020/07/04 17:13

こんにちは、

うまく投稿できていなかったようです。

ご質問を理解していないかもですが、取り敢えず。

抽出条件を検証してください。

Sub Test()
Dim startDate As Date, endDate As Date
Dim i As Long, Trgtime As Long
Dim wKey As String, ary()
Dim mydic As Object, mycont As Object, myKey
　　Set mydic = CreateObject("Scripting.Dictionary")
　　Set mycont = CreateObject("Scripting.Dictionary")
　　With Sheets("Data")
　　　　startDate = CDate(.Range("G2") & "/" & .Range("H2") & "/" & .Range("I2") & " " & .Range("J2").Text)
　　　　endDate = CDate(.Range("G3") & "/" & .Range("H3") & "/" & .Range("I3") & " " & .Range("J3").Text)
　　　　For i = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
　　　　　　If .Cells(i, "C") < endDate Or .Cells(i, "D") > startDate Then
　　　　　　　　If .Cells(i, "C") > startDate Then startDate = .Cells(i, "C")
　　　　　　　　If .Cells(i, "D") < endDate Then endDate = .Cells(i, "D")
　　　　　　　　wKey = .Cells(i, "B").Value
　　　　　　　　Trgtime = DateDiff("n", startDate, endDate)
　　　　　　　　If mydic.Exists(wKey) Then
　　　　　　　　　　mydic.Item(wKey) = mydic.Item(wKey) + Trgtime
　　　　　　　　　　mycont.Item(wKey) = mycont.Item(wKey) + 1
　　　　　　　　Else
　　　　　　　　　　mydic.Add wKey, Trgtime
　　　　　　　　　　mycont.Add wKey, 1
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　End With
　　myKey = mydic.Keys
　　ReDim ary(mydic.Count, 2)
　　For i = 0 To mydic.Count - 1
　　　　ary(i, 0) = myKey(i)
　　　　ary(i, 1) = mycont.Item(myKey(i))
　　　　ary(i, 2) = mydic.Item(myKey(i))
　　Next
　　Sheets("集計").Range("A1").Resize(UBound(ary), 3) = ary

End Sub

Sheets("集計").Range("A1")から出力しています。
出力数値は分単位ですがLongです。必要に応じ表示形式を設定してください。

エラー処理は行っていませんので適時お願いします。

全然違ったらごめんなさい。

この回答へのお礼

回答ありがとうございます。
ｴﾗｰ処理は適時行います。
お手数おかけして申し訳ないですが、今回はNo2様の回答が先だったのでﾍﾞｽﾄｱﾝｻｰはNo2様にします。
ありがとうございました！！

お礼日時：2020/07/04 18:27

No.3 回答者： tom04 回答日時： 2020/07/04 15:13

No.2です。

No.1さんの補足に
＞B欄の異常内容は種類が無限大にあるため・・・
とありますが、数万行のデータになることがあるのでしょうか？

前回のコードは単に2行目～最終行までループさせているだけなので
データ数次第では「応答なし」の状態になると思います。

元データが極端に多い場合は別の方法を考える必要があると思います。m(_ _)m

No.1 回答者： 銀鱗 回答日時： 2020/07/04 14:20

マクロである必要はありますか？

普通にSUMPRODUCT関数の応用で出来るような気がするんですけど...。
H6セルなら、
　=SUMPRODUCT((B:B=F6)*(D:D-C:C))
こんなんでできますよ。
当然ながら、計算結果を表示させるセルは「セルの表示形式」で
　[h]:mm
と設定しないと悲しい結果になりますけどね。
　※ この数式がやっていることを理解できないのであれば、無視してください。

G6セルは普通にCOUNTA関数で良いでしょう。

この回答へのお礼

回答ありがとうございます！
説明が抜けてました。
B欄の異常内容は種類が無限大にあるため一緒に集計したいです！
決まった内容が出てくるわけではないですので。

お礼日時：2020/07/04 14:28