FC2ブログ

スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

空き時間を求める 


以下の様なテーブルがあり、休憩時間 12:00 ~ 13:00 を除いた 8:40 ~ 18:00 での空き時間帯を求めたい

テーブル名「T1」
an予定日コード氏名開始時間終了時間
12013/03/011111AAA9:00:0010:00:00
22013/03/011111AAA13:00:0014:00:00
32013/03/011111AAA8:40:009:00:00
42013/03/011111AAA15:00:0015:30:00
52013/03/011111BBB8:00:0020:30:00
62013/03/011111AAA16:30:0017:30:00
72013/03/011111CCC8:00:0014:30:00

フィールド「時刻」(日付/時刻型:主キー)のみを持ったテーブル「T時刻」を新設し、
「時刻」には 0:00 ~ 23:59 のレコード( 60 * 24 = 1440 レコード )を作って、
タイムスライスしてみては・・・・・というものを回答していました。

VBA でも考えてみて・・・・あれれ・・・閉じられちゃった・・・・・という事で、
回答した内容と、回答しそこなった VBA を記述したものになります。

今回、サンプルファイルはありません。
もっといい方法があるんだと思いますが・・・・・ 教えてください。
3/12【追記】あり

※ エントリー 150 は現在作成中です。
(サンプルファイル kEnt150 は既に出来上がっているのですが・・・・)
 
以下の内容で回答してました。(抜粋)

変てこな考えかも(処理性能は考えてませんので・・・)

除外する・・・これは結構厄介なものと思います。
タイムスライスして、ある・ない・・・で結果を得ても良いのかも

フィールド「時刻」(日付/時刻型:主キー)のみのテーブル「T時刻」を作り、
0:00 ~ 23:59 までのデータを入れておきます。(60 * 24 = 1440 レコード)

この「T時刻」を基準に、対象者の予定日と開始時間、終了時間を結び付けて、
その結果、結びついていない時刻をグルグルとみて、空きの開始、終了を処理すれば・・・

元テーブル名を★★と仮定すると

SELECT Q1.時刻
FROM T時刻 AS Q1 LEFT JOIN
(SELECT * FROM ★★ WHERE 予定日=#2013/3/1# AND 氏名='AAA') AS Q2
ON (Q1.時刻 Between Q2.開始時間 AND Q2.終了時間)
WHERE
(Q2.氏名 Is Null) AND
((Q1.時刻 Between #8:40# AND #12:00#) OR (Q1.時刻 Between #13:00# AND #18:00#));

の様な感じで・・・・
得られる結果は、10:01 ~ 12:00 の 120レコードと 14:01 ~ 18:00 の240レコード
全体で 360レコードになるので、360分空いている事がわかります。
ただ、注意しないといけないのは、時刻の境目・・・・

例えば、上記の空きで 15:00 ~ 15:30 を予定に入れたら、
14:01 ~ 14:59、15:31 ~ 18:00 に分かれます。
ということは、レコード数=分 ではなくなる?

そこで、開始と終了の時刻が重ならないように、終了の方を1分前にします。

SELECT Q1.時刻
FROM T時刻 AS Q1 LEFT JOIN
(SELECT * FROM ★★ WHERE 予定日=#2013/3/1# AND 氏名='AAA') AS Q2
ON (Q1.時刻 Between Q2.開始時間 AND DateAdd("n",-1,Q2.終了時間))
WHERE
(Q2.氏名 Is Null) AND
((Q1.時刻 Between #8:40# AND #11:59#) OR (Q1.時刻 Between #13:00# AND #17:59#));

これで得られる結果は、10:00 ~ 11:59 の 120レコードと 14:00 ~ 17:59 の240レコード

上記の空きで 15:00 ~ 15:30 を予定に入れたら、
14:00 ~ 14:59、15:30 ~ 17:59 に分かれます。
(レコード数=分 でしょうか)

上記を指定して Recordset を得て、グルグル回して、時刻差が 1 分でなかったら
開始の時刻はそのまま・・・
終了の方は1分加算・・・・
で、求まっていくと思います。
空きの時間帯が複数あっても、グルグル回る時の処理を考えれば良いと思います。
また、どんな時間帯で登録されていようが、求まったものを処理するだけです。


上記では 1分間隔で「T時刻」内を作成していましたが、入力が 10分単位とかなら、
登録しておく「時刻」も 10分間隔で良いと思います。
グルグル回る時には、時刻差が 10分でなかったら・・・・とか

※ 上記回答で見ていたテーブル内容と、冒頭のテーブル「T1」の内容は異なります。

で、この回答時、曖昧にしていた VBA 処理(GetSliceTime)部分と、
VBA で処理したら(GetBreakTime)を考えてみました。
出来上がった時には、質問は既に閉じられていた為・・・・・悶々・・・々・

どちらも、引数として、予定日、氏名 の2つを与えると、データを配列で返す・・・
(空き時間帯がなければ、Null を返すように)
返す配列は、配列が配列になっていて、0: 開始時刻、1:終了時刻、2:分
  Dim v As Variant

  v = GetSliceTime(#3/1/2013#, "AAA")
  If (Not IsNull(v)) Then
    For i = 0 To UBound(v)
      Debug.Print v(i)(0), v(i)(1), v(i)(2) & "分"
    Next
  End If
ってな感じ・・・・で
10:00:00  12:00:00  120分
14:00:00  15:00:00  60分
15:30:00  16:30:00  60分
17:30:00  18:00:00  30分
が得られます。

標準モジュールに記述したんですけど、全内容は以下
Private Type TmData
  dtS As Date
  dtE As Date
End Type


Public Function GetBreakTime(dt As Date, sName As String) As Variant
  Dim rs As New ADODB.Recordset
  Dim vR As Variant
  Dim tpTm() As TmData, tpW As TmData, iCnt As Long
  Dim dtS As Date, dtE As Date
  Dim i As Long, j As Long

  iCnt = 1
  ReDim tpTm(iCnt)
  With tpTm(0)
    .dtS = #8:40:00 AM#
    .dtE = #12:00:00 PM#
  End With
  With tpTm(1)
    .dtS = #1:00:00 PM#
    .dtE = #6:00:00 PM#
  End With

  rs.Source = "SELECT * FROM T1 WHERE 予定日=#" & dt & "# AND 氏名='" & sName & "' ;"
  rs.Open , CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
  While ((Not rs.EOF) And (iCnt >= 0))
    dtS = rs("開始時間")
    dtE = rs("終了時間")
    i = 0
    Do While (i <= iCnt)
      If ((dtE <= tpTm(i).dtS) Or (tpTm(i).dtE <= dtS)) Then
        i = i + 1
      ElseIf ((dtS <= tpTm(i).dtS) And (tpTm(i).dtE <= dtE)) Then
        iCnt = iCnt - 1
        If (iCnt >= 0) Then
          For j = i To iCnt
            tpTm(j) = tpTm(j + 1)
          Next
          ReDim Preserve tpTm(iCnt)
        End If
      Else
        If ((tpTm(i).dtS < dtS) And (dtE < tpTm(i).dtE)) Then
          iCnt = iCnt + 1
          ReDim Preserve tpTm(iCnt)
          tpTm(iCnt).dtE = tpTm(i).dtE
          tpTm(i).dtE = dtS
          tpTm(iCnt).dtS = dtE
          Exit Do
        ElseIf (dtE < tpTm(i).dtE) Then
          tpTm(i).dtS = dtE
        Else
          tpTm(i).dtE = dtS
        End If
        i = i + 1
      End If
    Loop
    rs.MoveNext
  Wend
  rs.Close

  vR = Null
  If (iCnt >= 0) Then
    For i = 0 To iCnt - 1
      For j = i + 1 To iCnt
        If (tpTm(i).dtS > tpTm(j).dtS) Then
          tpW = tpTm(i)
          tpTm(i) = tpTm(j)
          tpTm(j) = tpW
        End If
      Next
    Next
    ReDim vR(iCnt)
    For i = 0 To iCnt
      vR(i) = Array(tpTm(i).dtS, tpTm(i).dtE, DateDiff("n", tpTm(i).dtS, tpTm(i).dtE))
    Next
  End If
  GetBreakTime = vR
End Function


Public Function GetSliceTime(dt As Date, sName As String) As Variant
  Dim rs As New ADODB.Recordset
  Dim sSql As String
  Dim vR As Variant
  Dim dtS As Date, dtNow As Date
  Dim i As Long
  Const sSqlBase As String = "SELECT Q1.時刻 FROM T時刻 AS Q1 " _
    & "LEFT JOIN (SELECT * FROM T1 WHERE 予定日=#{%1}# AND 氏名='{%2}') AS Q2 " _
    & "ON (Q1.時刻 Between Q2.開始時間 AND DateAdd('n',-1,Q2.終了時間)) " _
    & "WHERE (Q2.氏名 Is Null) AND " _
    & "((Q1.時刻 Between #8:40# AND #11:59#) OR (Q1.時刻 Between #13:00# AND #17:59#));"

  vR = Null
  sSql = sSqlBase
  sSql = Replace(sSql, "{%1}", dt)
  sSql = Replace(sSql, "{%2}", sName)
  rs.Source = sSql
  rs.Open , CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
  i = 0
  While (Not rs.EOF)
    If (i = 0) Then
      dtS = rs(0)
      i = 1
    Else
      If (DateDiff("n", dtNow, rs(0)) <> 1) Then
        dtNow = DateAdd("n", 1, dtNow)
        If (IsNull(vR)) Then
          ReDim vR(0)
        Else
          ReDim Preserve vR(UBound(vR) + 1)
        End If
        vR(UBound(vR)) = Array(dtS, dtNow, DateDiff("n", dtS, dtNow))
        dtS = rs(0)
      End If
    End If
    dtNow = rs(0)
    rs.MoveNext
  Wend
  rs.Close
  If (i <> 0) Then
    dtNow = DateAdd("n", 1, dtNow)
    If (IsNull(vR)) Then
      ReDim vR(0)
    Else
      ReDim Preserve vR(UBound(vR) + 1)
    End If
    vR(UBound(vR)) = Array(dtS, dtNow, DateDiff("n", dtS, dtNow))
  End If
  GetSliceTime = vR
End Function

 
GetSliceTime の処理は、回答した内容をそのままコードにしたので説明は不要かと・・・・

GetBreakTime の処理は、
・空き時間帯を配列で管理します。
 開始、終了・・・これが対で時間帯になるので、Type を使って・・・・これを配列で管理
 Type を使うと、まとめた考え方が出来るので、結構好きです。
・初期の空き時間帯、8:40 ~ 12:00 / 13:00 ~ 18:00 を作っておきます。
・ここからですが、1レコードごと、この空き時間帯を作り直していきます。
 (以下、空き時間帯になった気持ちで)

 私に関係ないから、他をあたって頂戴・・・・( i = i + 1 )
 ありゃりゃ・・・全部ですか・・・私は消えます・・・・続けて他も見て・・・・
 へっ、分割するの・・・・配列を増やして増殖しますか・・・・完結したから他は見なくて良いよ・・・
 片方変更?・・・・該当するところは変えたから、逆側は他をあたって頂戴・・・

 あっ、そうそう・・・空き時間帯がなくなったので・・・終わりにしない?
  While ((Not rs.EOF) And (iCnt >= 0))

・処理しきった後、増殖しているかもしれない。その場合、配列内は開始時間順じゃない・・・
 ソートしますか・・・・
 ここでも、Type を使った便利さがありますね(開始、終了 をまとめて操作できますね)
・返す内容に作り変えます。
 レコードがなかった時には、初期に設定した値そのままが返ります。

この2つの関数の動作確認用は、以下の様な雰囲気
Public Sub test()
  Dim sS As String
  Dim v As Variant
  Dim i As Long

  On Error Resume Next
  Do While (1)
    sS = InputBox("氏名を入力してください", "入力")
    If (Len(sS) = 0) Then Exit Do

    Debug.Print ">> GetSliceTime"
    v = GetSliceTime(#3/1/2013#, sS)
    If (Not IsNull(v)) Then
      For i = 0 To UBound(v)
        Debug.Print v(i)(0), v(i)(1), v(i)(2) & "分"
      Next
    End If

    Debug.Print ">> GetBreakTime"
    v = GetBreakTime(#3/1/2013#, sS)
    If (Not IsNull(v)) Then
      For i = 0 To UBound(v)
        Debug.Print v(i)(0), v(i)(1), v(i)(2) & "分"
      Next
    End If
    Stop
  Loop
End Sub


おまけ)テーブル「T時刻」に 1 分間隔でデータを作るのは以下
Public Sub MakeTime()
  Dim rs As New ADODB.Recordset
  Dim i As Integer, j As Integer

  CurrentProject.Connection.Execute "DELETE * FROM T時刻;"
  rs.Open "T時刻", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
  For i = 0 To 23
    For j = 0 To 59
      rs.AddNew
      rs("時刻") = TimeSerial(i, j, 0)
      rs.Update
    Next
  Next
  rs.Close
End Sub


今回、サンプルファイルはありません。
たぶん、そこそこ動くと思いますが、おかしかったら修正してください。

また、処理性能はどうなんでしょう・・・・
前述の動作確認用を動かしているだけじゃわかりません・・・・
1000 回や 10000 回 For で回して差をみる???・・・・意味があるのかなぁ・・・・
実際に組み込んで、応答に満足すれば・・・・で良い様な気がする。


※ もっと良い方法があるよ・・・・・教えてください。


【追記】3/12

前述した内容では、1人しかわかりませんね。
以下の様に記述を変更すれば、複数人での空き時間検索が出来ますね。
もちろん、1人でも OK です。

・GetBreakTime で
 rs.Source = "SELECT * FROM T1 WHERE 予定日=#" & dt & "# AND 氏名 IN (" & sName & ") ;"

・GetSliceTime で
 Const sSqlBase As String = "SELECT Q1.時刻 FROM T時刻 AS Q1 " _
   & "LEFT JOIN (SELECT * FROM T1 WHERE 予定日=#{%1}# AND 氏名 IN ({%2})) AS Q2 " _
   & "ON (Q1.時刻 Between Q2.開始時間 AND DateAdd('n',-1,Q2.終了時間)) " _
   & "WHERE (Q2.氏名 Is Null) AND " _
   & "((Q1.時刻 Between #8:40# AND #11:59#) OR (Q1.時刻 Between #13:00# AND #17:59#));"

上記記述に変更して、呼び出す時の指定の仕方を以下に変更します。
    v = GetSliceTime(#3/1/2013#, "'AAA','BBB'")

※ 指定がしにくい・・・・というのであれば、
    v = GetSliceTime(#3/1/2013#, "AAA,BBB")
とかにして、受け取った側で加工すれば良いですね。
その時には、
  Dim sS As String, v As Variant

  sS = ""
  For Each v In Split(sName, ",")
    sS = sS & ",'" & v & "'"
  Next
とかにして
・GetBreakTime では
 rs.Source = "SELECT * FROM T1 WHERE 予定日=#" & dt & "# AND 氏名 IN (" & Mid(sS, 2) & ") ;"
・GetSliceTime では
 sSql = Replace(sSql, "{%2}", Mid(sS, 2))

関連記事

2013/03/10

Category: サンプルかな

TB: --  /  CM: 8

top △

この記事に対するコメント

OKウエブで
 回答していただきありがとうございます。
大変恐縮なのですが。
 次のような時はどのようにしたらといのでしょうか?
OKに投稿していますが・・

スイマセンが助けてください(>_<)

 今度は帳票なのです!!

アクセスで大分類・中分類・小分類を作っています。


コンボボックスを連動させて,作成したのですが?

データー入力後,例えば中分類を変更しても,大分類や小分類がそのままで登録されてしまうのです。

それではダメですよね・・・

その部分がデータとしてあっていればいいのですが,違うければ弾いて欲しいやり方を

ご教示していただきたいのです。。。

ちなみに!

大分類に SELECT DISTINCT 配置署所 FROM ボンベ管理クエリ;

中分類に SELECT DISTINCT 署所記号番号 FROM ボンベ管理クエリ WHERE 配置署所=[大分類];


小分類に SELECT [ボンベID], [容器記号番号] FROM ボンベ管理クエリ WHERE 配置署所=[大分類] AND 署所記号番号=[中分類];


中分類と小分類には,イベントとして

Private Sub 小分類_Enter()
Me.小分類.Requery
End Sub

を書き込んでいます。

  ※ この質問をする場合のカテゴリ選択のようにしたいのです・・・・

ぜひどうかよろしくお願いします。

ももか #- | URL | 2013/03/13 13:48 * edit *

コメントありがとうございます。


帳票フォームでしたか。

回答でも記述していましたが、帳票フォームの場合、コントロールを重ねることをします。
コンボボックスは3つではありませんが、以下を参照ください。

accessの連結コンボについて
http://oshiete.goo.ne.jp/qa/7345694.html

回答内にある参照先も目を通してください。
私も、コントロールを重ねる・・・・この方法は hatena さんから教えて頂きました。

それらの方法を使って、もうチョッと・・・・っていうのを過去に記事にしてました。

重ねる
http://kikutips.blog13.fc2.com/blog-entry-129.html

すぐの対応は無理かも・・・・
サンプルデータを用意して・・・・
サンプルフォームを作って・・・・・
わかってもらえるように、文章を組み立てて・・・・・特に、これが苦手なんですけど

最近コメントを頂いた方への返信でも記述しましたが

> 原型となるサンプルファイルが欲しいのですが、ファイルを添付できる掲示板を
> hatena さんが用意されてますので、そちらを使う・・・っていう方法があります。
> 他の方からの回答もあるかもしれません。
> 実現する方法は1つではないので、いろいろな方法を知ることが出来るかもしれません。
> また、作成したサンプルを渡すことが出来ます。
>(私のは 2000 / 2003 / 2007 ですので、それで確認できるものに・・・)
> ※ データはサンプル用のデータにしてください
>
> hatena の Microsoft Access 掲示板
> http://hatena-access.progoo.com/bbs/
>
> ただ、既に質問を投稿されているようですのでマルチポストになります。
> 回答が付いてなければ、質問を削除後、上記を利用する・・・・でも

もし、急いでいるのなら
・該当のフォーム1つと
・それを動かすだけの、テーブル/クエリ
(データはサンプルに書き換えてください)

これだけの DB 作成後、zip にし、上記掲示板で添付してください。
(添付されたファイルは、全世界から見ることが出来るので【要注意】)


※ 知恵袋でも質問されてましたね
インデント付きの VBA 記述を提示したかったので、知恵袋ではない方に回答付けましたが・・・

以下も参照してみてください。

[Tips]マルチポストが嫌われる理由~なぜマルチポストは問題か?
http://stakasaki.at.webry.info/200512/article_3.html


余談)

実は、今記述途中(抜けていた)entry-150 は「帳票 + 3つのコンボ連携 + α」っていう標題。
大・中・小 の分類ではありませんが、それぞれのコンボボックスが連携する・・・・
(操作順関係なく・・・・サンプルファイルは、ずっと前にできていたんですけど・・・)

コントロールを重ねる・・・・これを、二段、三段・・・・
コンボボックスにコンボボックスを重ね、
また、あるところでは、さらにテキストボックスを重ねる・・・・
(チラツキが結構あり・・・・使いものにならないものかも)

ってなものになってます。近日公開出来ればと、ゆっくりしてますが・・・・

α 部分は、1つの Excel シートに、異なる Recordset 結果を連続出力するには・・・
( Recordset 部分は、クエリでも・・・・)
・・・に、なってます。

entry-151 を先に公開・・・・これは時間をおきたくなかった・・・・のが要因
どの質問だったのか、私の履歴から辿りやすく・・・・(不要なのかも)

(blog ネタの多くは、質問から得ているので・・・・・)

kiku #1a/xiM.Q | URL | 2013/03/13 16:23 * edit *

どうかよろしくお願いします。

すいません!

 マジに超分からないので

添付ファイルしちゃいます。

 どうかよろしくお願いします。

OKウエブの質問に添付しています・・・よろしくお願いします。

ももか #- | URL | 2013/03/13 17:28 * edit *

OKウエブには

 添付できないようです・・・・すいません

添付先ってどこなのでしょうか??

ももか #- | URL | 2013/03/13 17:45 * edit *

> hatena の Microsoft Access 掲示板

こちらに添付しました。

 スイマセンがどうかよろしくです・・・・

お忙しいところスイマセン・・・マジよろしく_(._.)_

ももか #- | URL | 2013/03/13 18:04 * edit *

Re: タイトルなし

では、文章だけで伝わるか・・・・また、チャンと動くか・・・・保証の限りではありませんが
前のフォームに戻せるように、バックアップはしっかりと・・・・

・コンボボックス中分類について
1)コンボボックス中分類をコピー&貼り付け(名前は何でも可)
  コピーして出来上がったコンボを XX と記述します。
2)XX の値集合ソースに記述した SQL から WHERE 部分を削除
3)タブストップを「いいえ」
4)マウスで XX クリック後、右クリックで、位置→最背面へ移動
5)XX を元のコンボボックス中分類に重ねます(表示の文字が綺麗に重なるように)
6)一度、別のコントロールをクリックし、重ねたコンボボックス部分をクリックします
  この時、コンボボックス中分類がクリックされたことを確認してください。
7)背景スタイルを「透明」に変更します。(この時に、下の文字も見えるかも)

上記手順で、中分類用の修正は終わりになるので、小分類に関しても上記順で同じように・・・

上記修正で、おそらく、単票用に提示した VBA で動くものになると思います。

※ コピーした時、コントロールソースも設定されているかと思いますが、そのままで・・・

※※ 回答のついていない質問は削除ください。
なお、回答が付いていたら、失礼のない様対処ください。


結果報告をお待ちしております。


※ hatena さんのところへの投稿コメント が付いていなかった時に書き出したので
これから、見てみますが・・・・まずは、上記手順でできたかどうか・・・・お願いします。

kiku #oNfrJm22 | URL | 2013/03/13 18:14 * edit *

やってみましたが・・・・

 すいませんできないようです。

短評用のVBAを貼り付けると,エラーを表示されちゃいます・・・

ももか #- | URL | 2013/03/13 20:14 * edit *

すいません・・・でした~

 仕事で掲示板を見ることが出来ず(T_T)

先ほど見てみましたら,添付が削除されていたようです

 ご迷惑をおかけしました。

もしよろしかったら

 私のメアドに添付していただくと幸いです。

お忙しいところ,とてもすいませんです。

ももか #NiBmXUvk | URL | 2013/03/14 15:56 * edit *

top △

コメントの投稿

Secret

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。