Excel VBA質問箱 IV

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

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


67880 / 76734 ←次へ | 前へ→

【13404】Re:時間帯の重なり除去
回答  Hirofumi E-MAIL  - 04/5/4(火) 16:21 -

引用なし
パスワード
   こんなのでも善いかな?
データは必ずA列がB列より小さい
データはA列をKeyとして並べ替えられる
結果の出力位置は、D、E、F列とする

Option Explicit

Public Sub TimeCalc()

  Const lngColCount As Long = 3
  
  Dim i As Long
  Dim j As Long
  Dim rngList As Range
  Dim vntData As Variant
  Dim vntResult As Variant
  Dim lngArrayEnd As Long
  
  'データListの範囲を取得
  Set rngList = ActiveSheet.Cells(1, "A").CurrentRegion
  'データ範囲をソート
  With rngList
    .Sort _
      Key1:=.Item(1, 1), Order1:=xlAscending, _
      Header:=xlNo, Orientation:=xlTopToBottom
  End With
  vntData = rngList.Value
  
  '時間の重なりを除去したデータの配列を作成
  j = 1
  ReDim vntResult(1 To lngColCount, 1 To j)
  vntResult(1, j) = vntData(j, 1)
  vntResult(2, j) = vntData(j, 2)
  For i = 2 To UBound(vntData, 1)
    If vntData(i, 1) > vntResult(2, j) Then
      j = j + 1
      ReDim Preserve vntResult(1 To lngColCount, 1 To j)
      vntResult(1, j) = vntData(i, 1)
      vntResult(2, j) = vntData(i, 2)
    Else
      If vntResult(1, j) <= vntData(i, 1) Then
        If vntResult(2, j) < vntData(i, 2) Then
          vntResult(2, j) = vntData(i, 2)
        End If
      End If
    End If
  Next i
  
  '分を集計
  j = j + 1
  ReDim Preserve vntResult(1 To lngColCount, 1 To j)
  For i = 1 To j - 1
    vntResult(3, i) = vntResult(2, i) - vntResult(1, i)
    vntResult(3, j) = vntResult(3, j) + vntResult(3, i)
  Next i
  
  '結果出力
  With rngList(1, rngList.Columns.Count + 2)
    '時分に書式設定
    With .Resize(j, lngColCount - 1)
      .NumberFormat = "h:mm"
    End With
    '分に書式設定
    With .Offset(, 2).Resize(j)
      .NumberFormat = "[mm]"
    End With
    '結果を出力
    With .Resize(j, lngColCount)
      .Value = Application.Transpose(vntResult)
    End With
  End With
  
End Sub

0 hits

【13332】時間帯の重なり除去 sこー 04/5/1(土) 20:27 質問
【13337】Re:時間帯の重なり除去 bykin 04/5/2(日) 12:12 回答
【13351】Re:時間帯の重なり除去 sこー 04/5/2(日) 21:23 質問
【13398】Re:時間帯の重なり除去 ちん 04/5/4(火) 13:29 回答
【13399】Re:時間帯の重なり除去 ちん 04/5/4(火) 13:57 発言
【13577】Re:時間帯の重なり除去 sこー 04/5/7(金) 23:42 お礼
【13404】Re:時間帯の重なり除去 Hirofumi 04/5/4(火) 16:21 回答

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