[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『二つの条件に合うものを数えたい。 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時台は合計なので165分となり重複しています。
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
マクロ案ありがとうございます!試してみたのですが、エラーがデータが範囲内にないというエラーが出て実効されません。何か問題があるのでしょうか。基礎データは上記と同じものです。ただ行が3000行となっています。
お時間ございましたらご教示願います。
( ぽん ) 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」に変更しました。 (と云うか、そう書いたつもりだったんですけど。。) これは今回のトラブルとは関係ありません。
>ただ行が3000行となっています。 当方のテストでは、3,000行を1、2秒で完了しています。
(半平太) 2014/08/21(木) 19:17
できました!ありがとうございます。
ご指摘の通り退店時間の空欄行が存在していました。
マクロできるようになりたいと思っているのですが、このマクロを実体験してさらに気持ちが増しましたが、、、ここまでのレベルになるには相当時間がかかりそうです。。。
お時間を割いていただき本当にありがとうございました!!
(ぽん) 2014/08/22(金) 05:44
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.