😎

Excelファイル内のすべての日付を集計するVBAコード

2025/04/30に公開

Excel VBA

tech

チェックシートの確認に便利なVBAコードです。

AIでフルコードを作成できる昨今、VBAができるエンジニアに需要があるのか定かではありませんが、それでも少し頑張って作っていた記憶があるので上げておきます。

動作確認

全シートに入力されている日付（⚪︎月⚪︎日でも可）をカウントします。
Mac版とWindos版の両方で使用できることを確認しました。

ソースコード

Sub CountDatesByDayAndDisplayAscending()
    Dim ws As Worksheet
    Dim cell As Range
    Dim startDate As Date
    Dim endDate As Date
    Dim dateList As Collection
    Dim dateCounts As Collection
    Dim currentDate As Date
    Dim i As Long
    Dim j As Long
    Dim found As Boolean
    Dim msg As String

    Set dateList = New Collection
    Set dateCounts = New Collection

    startDate = DateSerial(2025, 4, 30)
    endDate = DateSerial(2025, 6, 1)

    ' 全シートの各セルをチェック
    For Each ws In ThisWorkbook.Worksheets
        For Each cell In ws.UsedRange
            If IsDate(cell.Value) Then
                currentDate = cell.Value
                If currentDate >= startDate And currentDate <= endDate Then
                    ' すでに登録されているかチェック
                    found = False
                    For i = 1 To dateList.Count
                        If dateList(i) = currentDate Then
                            ' 既にあればカウントアップ
                            dateCounts(i) = dateCounts(i) + 1
                            found = True
                            Exit For
                        End If
                    Next i
                    If Not found Then
                        ' 新規日付を追加
                        dateList.Add currentDate
                        dateCounts.Add 1
                    End If
                End If
            End If
        Next cell
    Next ws

    ' バブルソートで昇順に並べ替え
    Dim tempDate As Variant
    Dim tempCount As Variant
    For i = 1 To dateList.Count - 1
        For j = i + 1 To dateList.Count
            If dateList(i) > dateList(j) Then
                tempDate = dateList(i)
                dateList(i) = dateList(j)
                dateList(j) = tempDate
                tempCount = dateCounts(i)
                dateCounts(i) = dateCounts(j)
                dateCounts(j) = tempCount
            End If
        Next j
    Next i

    ' 結果をメッセージボックスに表示
    msg = "指定された期間内の日付ごとのセル数（昇順）:" & vbCrLf & vbCrLf
    For i = 1 To dateList.Count
        msg = msg & Format(dateList(i), "yyyy/mm/dd") & ": " & dateCounts(i) & " 個" & vbCrLf
    Next i

    MsgBox msg, vbInformation, "集計結果"
End Sub

動作確認

ソースコード

Discussion