[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『二つの条件に合うものを数えたい。 No2』（ぽん ）
wisemac21さま
なんでか更新がうまくいきません・・・
ありがとうございます。ご教示いただいた式を入れてみましたが、やはり●の重複があり、集計表が望んだものになりません。
この表ではお店にお客様がいた時間を算出したいので重複がないようにしたいです。
下記データの滞在時間の後に、●が09:00から17:00まで列で表示されるようになっています。
下記は抜粋データですが、重複時間があります。そこを重複しないように計算したいのですが自分では力不足でできません。時間計算の部分にはご教示頂いたCOUNTIFSが入力されています。
入店 退店 滞在時間 11:00 12:00 13:00 14:00 15:00 1/4 14:05 14:25 00:20 0 0 0 20 0 0 1/4 14:09 14:15 00:06 0 0 0 6 0 0 1/4 14:16 14:56 00:40 0 0 0 40 0 0 1/4 14:22 14:34 00:12 0 0 0 12 0 0 1/4 14:27 16:00 01:33 0 0 0 33 60 0 1/4 14:30 14:56 00:26 0 0 0 26 0 0 1/4 14:49 15:00 00:11 0 0 0 11 0 0 1/4 15:07 16:10 01:03 0 0 0 0 53 10 1/4 16:23 16:30 00:07 0 0 0 0 0 7
集計表は下記のようになっており、wisemec21さんの関数 SUMIFSが入っています。
下記の14時台は合計なので１６５分となり重複しています。
09:00 10:00 11:00 12:00 13:00 14:00 15:00 16:00 17:00
1/4 1 7 12 0 2 165 113 46 0
お時間を取らせてしまい大変申し訳ありませんが、お分かりになればよろしくお願いします。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
列の表現が現状1時間単位になっていますが、これを1分単位にする。
すると、データ部が0か1だけになるので、これを分単位で縦にチェック、作業行に0か1を残す。
次に、1時間分ずつ合計していくと、重複無視の値が得られると思います。
（???） 2014/08/20(水) 08:51
マクロ案 （しか考えられない、私には）
A:Cの2行目以降に基礎データがあるとして、
当該シートの「シート見出し」を右クリック→コードの表示 を選択。 画面中央の白いエリアに下記コードを貼り付け。
マクロ名「durationWithoutOverlapping」を実行。
<結果図> 行 ___A___ __B__ __C__ ____D____ ____E____ __F__ __G__ __H__ __I__ __J__ __K__ __L__ __M__ 1 日付 入店 退店 滞在時間 9:00 10:00 11:00 12:00 13:00 14:00 15:00 16:00 2 1月14日 14:05 14:25 0:20 2014/1/14 0 0 0 0 0 55 60 17 3 1月14日 14:09 14:15 0:06 2014/2/10 7 0 0 0 0 0 0 0 4 1月14日 14:16 14:56 0:40 5 1月14日 14:22 14:34 0:12 6 1月14日 14:27 16:00 1:33 7 1月14日 14:30 14:56 0:26 8 1月14日 14:49 15:00 0:11 9 1月14日 15:07 16:10 1:03 10 1月14日 16:23 16:30 11 2月10日 9:01 9:05 12 2月10日 9:04 9:08
’シートモジュールに貼り付けるマクロ ----- 'Option Explicit
Sub durationWithoutOverlapping()
Dim NN As Long, MM As Long
Dim dic As Object
Dim valToProc As Variant
Dim TimeByMinute(1 To 480) As Long
Dim OverAllTimeByMinute
Dim Resultes()
Dim aResult
Dim aDay
Dim minutesByHour
Set dic = CreateObject("Scripting.Dictionary")
valToProc = Range("A2", Cells(Rows.Count, "A").End(xlUp)).Resize(, 3).Value
For NN = 1 To UBound(valToProc)
If dic.Exists(valToProc(NN, 1)) Then
OverAllTimeByMinute = dic(valToProc(NN, 1))
Call update(valToProc(NN, 2), valToProc(NN, 3), OverAllTimeByMinute)
dic(valToProc(NN, 1)) = OverAllTimeByMinute
Else
Erase TimeByMinute
Call update(valToProc(NN, 2), valToProc(NN, 3), TimeByMinute)
dic.Add valToProc(NN, 1), TimeByMinute
End If
Next NN
'集計
ReDim Resultes(1 To dic.Count, 1 To 8)
MM = 0
For Each aDay In dic
MM = MM + 1
aResult = dic(aDay)
Resultes(MM, 1) = aDay
For NN = 1 To 480
minutesByHour = minutesByHour + aResult(NN)
If NN Mod 60 = 0 Then
Resultes(MM, NN / 60) = minutesByHour
minutesByHour = 0
End If
Next NN
Next
'表示
Columns("E:M").ClearContents
Range("F1:M1").Value = [(column(A:H)+8)/24]
Range("F1:M1").NumberFormatLocal = "h:mm"
Range("E2").Resize(dic.Count, 1).Value = Application.Transpose(dic.Keys)
Range("F2").Resize(dic.Count, 8).Value = Resultes
End Sub
Sub update(Time, TimeOut, ByRef durationByMinute)
Dim NN As Long
Dim startTime As Date
Dim startPos As Long
Dim endTime As Date
Dim endPos As Long
startTime = Application.Min(Application.Max(TimeValue("9:00"), Time), TimeOut)
startPos = CLng(startTime * 1440) - 539
endTime = Application.Max(Application.Min(TimeValue("17:00"), TimeOut), Time)
endPos = CLng(endTime * 1440) - 540
For NN = startPos To endPos
durationByMinute(NN) = 1
Next NN
End Sub
（半平太） 2014/08/20(水) 14:23
マクロ案ありがとうございます！試してみたのですが、エラーがデータが範囲内にないというエラーが出て実効されません。何か問題があるのでしょうか。基礎データは上記と同じものです。ただ行が３０００行となっています。
お時間ございましたらご教示願います。
（ ぽん ） 2014/08/21(木) 16:36
＞エラーがデータが範囲内にないというエラーが出て実効されません。
退店時刻だけが未入力になっているデータ行が存在しないですか？
以下、その場合は、その顧客データはノーカウントにすることにします。 「upDate」プロシージャの方を下記コードで全面書換えしてください。
Sub update(TimeIn, TimeOut, ByRef durationByMinute)
Dim NN As Long
Dim startTime As Date
Dim startPos As Long
Dim endTime As Date
Dim endPos As Long
startTime = Application.Max(TimeValue("9:00"), TimeIn)
startPos = CLng(startTime * 1440) - 539
endTime = Application.Max(Application.Min(TimeValue("17:00"), TimeOut), TimeIn)
endPos = CLng(endTime * 1440) - 540
For NN = startPos To endPos
durationByMinute(NN) = 1
Next NN
End Sub
※なお、Timeと云う紛らわしい変数名を使っていたので「TimeIn」に変更しました。 (と云うか、そう書いたつもりだったんですけど。。） これは今回のトラブルとは関係ありません。
＞ただ行が３０００行となっています。 当方のテストでは、3,000行を１、２秒で完了しています。
（半平太） 2014/08/21(木) 19:17
できました！ありがとうございます。
ご指摘の通り退店時間の空欄行が存在していました。
マクロできるようになりたいと思っているのですが、このマクロを実体験してさらに気持ちが増しましたが、、、ここまでのレベルになるには相当時間がかかりそうです。。。
お時間を割いていただき本当にありがとうございました！！
（ぽん） 2014/08/22(金) 05:44
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.