Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


40155 / 76732 ←次へ | 前へ→

【41678】Re:時間の重なり分を除いた日ごとの合計を別シートに当てはめたい
発言  [名前なし]  - 06/8/19(土) 16:15 -

引用なし
パスワード
   [#41483]のかみちゃんさんのコードを元に、

>時間順にソートして2行目のAが1行目のBより大きければ重なり無しとみなし、
>小さければ2行目のAが1行目のAより大きくて、2行目のBが1行目のBより
>大きければBの値を上書きしていく

というコードにしてみました。

Sub Macro1()
  Dim LastCell As Range
  Dim c As Range
  '日別集計用の変数31要素
  Dim vntData(1 To 31) As Long 'ちょっと変更
  Dim DayNum As Long, TimeS As Date, TimeL As Date '追加
  Dim TimeS1 As Date, TimeL1 As Date '追加
  
  Sheets("Sheet1").Activate
  
  '日→時間1→時間2の順で並べ替え
  Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Key2:=Range("B1"), _
  Key3:=Range("B3"), Header:=xlNo
  
  Set LastCell = Cells(Cells.Rows.Count, 1).End(xlUp)
  DayNum = 0
  For Each c In Range("A1", LastCell)
    '以下変更
    TimeS1 = c.Offset(, 1).Value '時間1を取得
    TimeL1 = c.Offset(, 2).Value '時間2を取得
    
    If TimeS1 > TimeL1 Then TimeL1 = TimeL1 + 1   '24時をまたがる場合
      
    If Val(c.Value) = DayNum Then '日が同じ場合
     '保存している時間2と比較して、時間2が小さい場合
     '→計算済みの時間と完全に重複しているので、DateDiffの結果を0にする
      If TimeL > TimeL1 Then
        TimeS = TimeL
      Else
        TimeS = TimeS1
       '保存している時間2と比較して、時間1のほうが小さい場合
       '→重複している時間を除く
        If TimeS < TimeL Then TimeS = TimeL
        TimeL = TimeL1
      End If
    Else '日が変わった場合
      TimeS = TimeS1
      TimeL = TimeL1
    End If
    
    '配列に結果を計算
    vntData(Val(c.Value)) = vntData(Val(c.Value)) + DateDiff("n", TimeS, TimeL)
    
    DayNum = Val(c.Value) '日を保存
  
  '-- ※1 D列に時間(分)を出力する部分(不要なら削除)
    c.Offset(, 3).Value = DateDiff("n", TimeS1, TimeL1) 'D列に出力
'--------------------------------------------------------------------------
  '-- ※2 E,F列に実際に計算に使う時刻を出力する部分(不要なら削除)
    With WorksheetFunction
      c.Offset(, 4).Value = .Text(TimeS, "[hh]:mm:ss") 'E列に出力
      c.Offset(, 5).Value = .Text(TimeL, "[hh]:mm:ss") 'F列に出力
    End With
'--------------------------------------------------------------------------
  
  Next
  Sheets("Sheet2").Range("B1").Resize(UBound(vntData)).Value = _
  Application.Transpose(vntData)
  
  MsgBox "集計完了"
End Sub

一応、下記のようなデータで確かめました。

   A    B
2  10:00  10:30
2  10:00  11:00
2  10:40  11:10
4  13:20  13:50
4  14:00  14:30
4  23:00  0:10
6  9:00  9:50
6  9:30  10:10
7  9:30  10:50
7  10:00  10:40
7  10:20  10:50
7  10:30  11:00
8  23:00  0:30
8  23:20  0:10
8  23:50  1:00
9  0:00  0:30
9  23:00  0:00
9  23:30  0:50
2 hits

【41674】時間の重なり分を除いた日ごとの合計を別シートに当てはめたい みなみ 06/8/19(土) 12:34 質問
【41677】Re:時間の重なり分を除いた日ごとの合計... 飛ばない豚 06/8/19(土) 15:16 回答
【41678】Re:時間の重なり分を除いた日ごとの合計を... [名前なし] 06/8/19(土) 16:15 発言
【41679】Re:時間の重なり分を除いた日ごとの合計... 飛ばない豚 06/8/19(土) 16:41 回答
【41680】Re:時間の重なり分を除いた日ごとの合計を... みなみ 06/8/19(土) 17:17 発言
【41684】Re:時間の重なり分を除いた日ごとの合計を... Hirofumi 06/8/20(日) 1:44 回答
【41690】Re:時間の重なり分を除いた日ごとの合計を... みなみ 06/8/20(日) 8:52 お礼

40155 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free