Excel VBA質問箱 IV

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

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


40156 / 76732 ←次へ | 前へ→

【41677】Re:時間の重なり分を除いた日ごとの合計...
回答  飛ばない豚  - 06/8/19(土) 15:16 -

引用なし
パスワード
   ▼みなみ さん:
1日分の数直線に見立てた変数(mySCALE)を用意し、
該当のところを塗りつぶす(1を立てる)ようにし、
その数を数えてみました。

リンク先はよく見てませんが、似たような考えだと思います(多分)

Sub sub_時間計算()
  Dim mySCALE(1 To 1440) As Integer
  Dim myCALC(1 To 31) As Long
  Dim myTimeS As Date
  Dim myTimeE As Date
  Dim myRange As Range
  Dim myLastR As Range
  Dim myDay As Long
  Dim myLooP As Long
  
  Sheets("Sheet1").Activate
  Set myLastR = Cells(Cells.Rows.Count, 1).End(xlUp)
  
  For myDay = 1 To 31
    Erase mySCALE
    For Each myRange In Range("A1", myLastR)
      If myRange.Value = myDay Then
        myTimeS = myRange.Offset(0, 1).Value
        myTimeE = myRange.Offset(0, 2).Value
        If myTimeS > myTimeE Then
          For myLooP = 1 To Hour(myTimeE) * 60 _
                   + Minute(myTimeE) - 1
            mySCALE(myLooP) = 1
          Next myLooP
          For myLooP = Hour(myTimeS) * 60 _
                 + Minute(myTimeS) To 1440
            mySCALE(myLooP) = 1
          Next myLooP
        Else
          For myLooP = Hour(myTimeS) * 60 + Minute(myTimeS) _
              To Hour(myTimeE) * 60 + Minute(myTimeE) - 1
            mySCALE(myLooP) = 1
          Next myLooP
        End If
      End If
    Next myRange
    
    For myLooP = 1 To 1440
      myCALC(myDay) = myCALC(myDay) + mySCALE(myLooP)
    Next myLooP
  Next myDay
  
  Sheets("Sheet2").Range("B1").Resize(UBound(myCALC)).Value = _
                    Application.Transpose(myCALC)
  
End Sub


それでは。(^・ω・^)

0 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 お礼

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