Excel VBA質問箱 IV

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

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


19422 / 76737 ←次へ | 前へ→

【62747】Re:条件と一致するセルをカウントして件数を表示したい
回答  Hirofumi  - 09/8/27(木) 7:40 -

引用なし
パスワード
   こなのでは?

表Aは、「開始日」がA列、「終了日」がB列で1行目に列見出しが有とします
表Bは、A列1行目に「基準日」の行見出しが有る物とします
集計用テーブル(ハッシュテーブル)を作成して集計します
(ハッシュテーブル = 日付と配列の添え字を関連付けた配列変数)

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim lngRows As Long
  Dim rngList As Range
  Dim rngResult As Range
  Dim vntData As Variant
  Dim vntMax As Variant
  Dim vntMin As Variant
  Dim vntTable As Variant
  Dim lngDay As Long
  Dim strProm As String

  '◆Listの先頭セル位置を基準とする(先頭列の列見出しのセル位置)
  Set rngList = Worksheets("表A").Cells(1, "A")

  '◆結果出力の先頭セル位置を基準とする(先頭列の列見出しのセル位置)
  Set rngResult = Worksheets("表B").Cells(1, "A")
  
  With rngList
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '「開始日」A列、「終了日」B列データを配列に取得
    vntData = .Offset(1).Resize(lngRows, 2).Value
    '「開始日」列、「終了日」列から最小最大の日付を取得
    vntMax = Application.WorksheetFunction.Max(.Offset(1).Resize(lngRows, 2))
    vntMin = Application.WorksheetFunction.Min(.Offset(1).Resize(lngRows, 2))
  End With
  
  '集計用テーブルを作成
  ReDim vntTable(1, vntMax - vntMin)
  
  '日付を上から下に繰り返し
  For i = 1 To lngRows
    '「開始日」が空白で無いなら
    If vntData(i, 1) <> "" Then
      'ハッシュ値を計算
      lngDay = vntData(i, 1) - vntMin
      'ハッシュの位置に集計
      vntTable(0, lngDay) = vntTable(0, lngDay) + 1
    End If
    '「終了日」が空白で無いなら
    If vntData(i, 2) <> "" Then
      'ハッシュ値を計算
      lngDay = vntData(i, 2) - vntMin
      'ハッシュの位置に集計
      vntTable(1, lngDay) = vntTable(1, lngDay) + 1
    End If
  Next i
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  '結果を出力
  With rngResult
    'データをクリア
    .Parent.UsedRange.ClearContents
    '結果を出力
    .Offset(1, 1).Resize(2, UBound(vntTable, 2) + 1).Value = vntTable
    '行見出しを出力
    For i = 1 To 3
      .Offset(i - 1).Value = Choose(i, "基準日", "開始日", "終了日")
    Next i
    '基準日を出力
    ReDim vntTable(vntMax - vntMin)
    For i = 0 To vntMax - vntMin
      vntTable(i) = vntMin + i
    Next i
    With .Offset(, 1).Resize(, UBound(vntTable) + 1)
      .NumberFormat = "m/d"
      .Value = vntTable
    End With
  End With
    
  strProm = "処理が完了しました"
   
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList = Nothing
  Set rngResult = Nothing
   
  MsgBox strProm, vbInformation
     
End Sub

0 hits

【62745】条件と一致するセルをカウントして件数を表示したい エクセル初心者 09/8/27(木) 5:25 質問
【62747】Re:条件と一致するセルをカウントして件数... Hirofumi 09/8/27(木) 7:40 回答
【62748】Re:条件と一致するセルをカウントして件数... kanabun 09/8/27(木) 9:31 発言

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