マクロで日付の最大と最小を求め、１ヶ月ごとに転記していきたい。

Question

マクロを使って、Sheet1からSheet2のように、Sheet1に存在する全ての「年/月/日」の最大と最小を求めて、それを最小から最大までSheet2のように１ヶ月ごとで転記していきたいです。（日の部分は固定）

一例でも構いませんので、教えていただけないでしょうか。

Sheet1

Sheet2

Answer 1

次のコードでいかがでしょうか。

Function f_blnTest1() As Boolean
    Dim wsh As Worksheet
    Dim datMin As Date
    Dim datMax As Date
    Dim rng As Range
    Dim dat As Date
    Dim i As Long
    
    Set wsh = Worksheets("Sheet1")
    datMin = DateValue("9999/12/31")
    
    For Each rng In wsh.UsedRange
        If IsDate(rng.Value) Then
            If rng.Value < datMin Then
                datMin = rng.Value
            End If

            If datMax < rng.Value Then
                datMax = rng.Value
            End If
        End If
    Next rng
    
    dat = datMin
    i = 0
    Do Until dat > datMax
        Worksheets("Sheet2").Cells(2, "D").Offset(, i).Value = dat
        i = i + 1
        dat = DateAdd("m", i, datMin)
    Loop
    
End Function