[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『利用者のいない時間帯の割り出し方』（教えて下さい）
A列に日付、B列に利用開始時間、C列に利用終了時間が入っているデータがあるのですが、その中から営業時間の間で利用者のいない時間を分単位で日付毎に抽出することは出来ますでしょうか？
現状日付・時間帯毎の利用者数などは出せているのですが、利用されていない時間帯の絞り方がわからず困っています。
どうかご教授ください
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
（γ） 2021/01/27(水) 05:38
開始 終了 10:00 10:30 11:00 11:10 のような形式でいいんですか？
それとも、
10:00 10:01 ・・・ のような表に空きのマークを付けるとかなんですか？ 「分単位で」というのは、単位のことだけ言っているのか、 表示形式のことを言っているのか不明なんですよ。
それはシートのどこに、どのようなレイアウトで示すんですか？
ということを確認しているんですが。
（γ） 2021/01/27(水) 21:19
開始 終了 日付
10:00 10:30 2021/1/27
11:00 11:10 2021/1/27
のような感じで1000件近いデータがあります。(利用可能時間は07:00～15:00とします)
この表で行くと1/27は10:30～11:00までの00:30が利用のなかった時間に該当します。
それを求めたいという事でした。
どうかよろしくお願いします。
（教えて下さい） 2021/01/28(木) 23:59
以下のようなレイアウトとしました。
<<Sheet1>> 元データ
A B C
1 利用日 開始時刻 終了時刻
2 2021/1/27 9:00 10:00
3 2021/1/27 9:50 10:30
4 2021/1/27 10:32 10:40
5 2021/1/27 11:00 11:30
6 2021/1/27 11:40 12:00
7 2021/1/27 12:10 12:30
8 2021/1/27 12:10 12:50
9 2021/1/27 13:00 13:10
10 2021/1/27 13:20 13:40
11 2021/1/27 13:50 14:00
（時刻は順不同でかまいません）
<<Sheet2>> 結果
A B C
1 日付 空き開始 空き終了
2 2021/1/27 10:30 10:32
3 2021/1/27 10:40 11:00
4 2021/1/27 11:30 11:40
5 2021/1/27 12:00 12:10
6 2021/1/27 12:50 13:00
7 2021/1/27 13:10 13:20
8 2021/1/27 13:40 13:50
9 2021/1/27 14:00 15:00
(一行目の見出しは事前に入れておいてください）
●マクロは、以下に示しますが、事前に次の準備と、マクロの修正（必要なら）をして下さい。
(1)作業用に「作業用」という名前のシートを使いますので、
既にそうしたシートがもしあれば、名前を別のものに変更しておいてください。
(2)マクロの中で■をつけたところに、二つのシート名、営業開始時刻、営業終了時刻などが
設定してあります。実態に応じて、必要な修正をして下さい。
●マクロは以下です。 ・標準モジュールにコピーし、 ・上記の修正をした後、 ・マクロ main を実行して下さい。
=== 次行以下をまるごとコピーして下さい。=== Dim ws1 As Worksheet Dim ws2 As Worksheet Dim tool As Worksheet
Dim 営業開始時刻 As Date Dim 営業終了時刻 As Date Dim 営業時間範囲 As Range Dim oneminute As Date Dim pos As Long '結果書き込み先の行番号
Sub main()
Dim k As Long
Dim d As Date
Dim startR As Long
Dim endR As Long
Dim startD As Date
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set ws1 = Worksheets("Sheet1") '元データのシート ■ 要修正
Set ws2 = Worksheets("Sheet2") '空き時間を書くシート ■ 要修正
'定数値の設定
営業開始時刻 = CDate("7:00") '■ 必要に応じて修正
営業終了時刻 = CDate("15:00") '■ 必要に応じて修正
oneminute = CDate("0:01")
'作業領域の設定
Call setting ' 作業用シートの設定
Set 営業時間範囲 = map(営業開始時刻, 営業終了時刻 - oneminute)
ws2.Columns("A").NumberFormatLocal = "yyyy/m/d"
ws2.Columns("B:C").NumberFormatLocal = "h:mm"
'利用日ごとの処理
pos = 2 '結果の書き込み開始行番号
startD = ws1.Cells(2, "A") '利用日の初期値
startR = 2 '算定対象の開始行
For k = 2 To ws1.Cells(Rows.Count, "A").End(xlUp).Row + 1
'最後の日を処理するために +1 していることに注意
d = ws1.Cells(k, "A")
If d <> startD Then '日にちが変わったら、1日の処理を実行
endR = k - 1
' strtR行からendR行までを対象に空き時間を調査
Call 利用なし期間の分析(startR, endR) 'ここが作業の中心
startD = d '次に向けた準備
startR = k
End If
Next
ws2.Activate
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
'toolシートに作業用領域を設定
Private Function setting()
Dim ws As Worksheet
Dim flag As Boolean
Dim k As Long
Dim t As Double
'作業用シートの有無を調べ、なければ追加
For Each ws In Worksheets
If ws.Name = "作業用" Then
Set tool = ws
flag = True: Exit For
End If
Next ws
If flag = False Then
Set tool = Worksheets.Add(after:=Worksheets(Worksheets.Count))
tool.Name = "作業用"
End If
tool.Columns("A").NumberFormatLocal = "h:mm"
tool.Columns("A").ClearContents
'1分刻みの表を作成
For t = 営業開始時刻 To 営業終了時刻 - oneminute Step oneminute
k = k + 1
tool.Cells(k, "A") = t
Next
End Function
' strtR行からendR行までの利用状況をもとに、空き時間を作成して書き込み
Private Sub 利用なし期間の分析(startR As Long, endR As Long)
Dim myUnion As Range
Dim diff_rng As Range
Dim tmp As Range
Dim area As Range
Dim k As Long
'使用時間帯の統合
For k = startR To endR
Set tmp = map(ws1.Cells(k, "B"), ws1.Cells(k, "C") - oneminute)
If myUnion Is Nothing Then
Set myUnion = tmp
Else
Set myUnion = Union(myUnion, tmp)
End If
Next
'全体から、使用時間帯を除いた差集合を算出
Set diff_rng = diff(営業時間範囲, myUnion)
'ワークシートに書き込み
For Each area In diff_rng.Areas
ws2.Cells(pos, "A") = ws1.Cells(startR, "A")
ws2.Cells(pos, "B") = area(1).Value
ws2.Cells(pos, "C") = area(area.Count).Value + oneminute
pos = pos + 1
Next
End Sub
Private Function posOfTime(d As Date) As Long
Dim v As Double
If d < 営業開始時刻 Then
MsgBox "営業開始前"
Exit Function
End If
posOfTime = (CDbl(d) - CDbl(営業開始時刻)) / CDbl(oneminute) + 1
End Function
'使用開始時間から使用終了時刻までを表す「セル範囲」を算定
Private Function map(startTime As Date, endTime As Date) As Range
Dim r1&, r2&
r1 = posOfTime(startTime)
r2 = posOfTime(endTime)
Set map = tool.Range(tool.Cells(r1, "A"), tool.Cells(r2, "A"))
End Function
'差集合の算出（rngAのなかで、rngBを除いたセル範囲）
Private Function diff(rngA As Range, rngB As Range) As Range
Dim r As Range
For Each r In rngA
If Intersect(r, rngB) Is Nothing Then
If diff Is Nothing Then
Set diff = r
Else
Set diff = Union(diff, r)
End If
End If
Next
End Function
○マクロの中身には多分あまり興味ないと思いますが、若干の補足をしておきます。 少しごてごてしていますが、考え方は以下のとおり。 ・利用状態を 「作業用シートのA列」に1分単位で設定したセル範囲と対応づけ、 ・先だって質問にあった、セル範囲の差集合を求めるロジックを使って、 全体から利用済み期間を除く処理を行いました。 ・動作確認は一応しましたが、エラー時の対応とか、余り、念入りに見ていません。
○速度的には改善の余地があると思いますが、そこそこの時間ですみます。 100日×10件の1000件だと1.4秒程です。
○例えば、分単位の表を作り、利用済みのセルには 1を書き込み、 空白セルをSpecialCellsで求め、各エリアから空き時間の開始・終了を読み取る、 などといった手法はすぐに思いつきます。このほうが多分早いと思います。
もっと斬新なアイデアが出てくるでしょうから楽しみにしています。
なお、使用目的によりますが、セル範囲に色を使ってマークすることで、 空き時間を視覚的に表示するのも有益じゃないかと思います。
（γ） 2021/01/29(金) 05:40
>現状日付・時間帯毎の利用者数などは出せているのですが
まずチェックしたい時間全部の一覧表を用意すればいいのでは？
あと、日付と時間が別のセルにあると扱いにくいので、
仮にでも日付と時間を足して、1つのセルに日時を入れとくと、
CountIf関数で数えられそう？
ちなみに、関数で結果を求めるのですか？
マクロで結果を求めるのですか？
（まっつわん） 2021/01/29(金) 19:05
Dim dt(), r As Range, rr As Range, x As Range, c As Range, cc As Range, ctr As Long
For Each x In Range("C2:C" & Rows.Count).SpecialCells(2)
If WorksheetFunction.CountIf(Range("C1:C" & x.Row), x.Value) = 1 Then
For Each c In Range("A:A").SpecialCells(2)
If c.Offset(, 2).Value = x.Value Then
Set cc = Range(Range("A" & Hour(c.Value) * 60 + Minute(c.Value)), Range("A" & Hour(c.Offset(, 1).Value) * 60 + Minute(c.Offset(, 1).Value)))
If r Is Nothing Then
Set r = cc
Else
Set r = Union(r, cc)
End If
End If
Next c
For Each c In Range("A420:A900")
If Intersect(r, c) Is Nothing Then
If rr Is Nothing Then
Set rr = c
Else
Set rr = Union(rr, c)
End If
End If
Next c
For Each c In rr.Areas
ReDim Preserve dt(1, ctr)
dt(0, ctr) = Int(c.Cells(1).Row / 60) & ":" & Format(c.Cells(1).Row - Int(c.Cells(1).Row / 60) * 60, "00") & "～" & Int(c.Cells(c.Count).Row / 60) & ":" & Format(c.Cells(c.Count).Row - Int(c.Cells(c.Count).Row / 60) * 60, "00")
dt(1, ctr) = Format(x.Value, "yyyy/m/d")
ctr = ctr + 1
Next c
Set r = Nothing
Set rr = Nothing
End If
Next x
Sheets.Add after:=ActiveSheet
Range("A1:B" & ctr) = Application.Transpose(dt)
End Sub
（mm） 2021/02/01(月) 14:44
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.