フィルをマクロで操作し、その戻り値をRangeとする関数～補足～

昨日は、フィルをマクロで操作したうえで、その戻り値をRangeとする関数について微調整を行い、即席カレンダーを作成してみた。
infoment.hatenablog.com

今日は、この件について一点補足する。
f:id:Infoment:20191230224518p:plain

昨日、カレンダーを作成する際に、まず７日間隔で５行１列のデータを作成した。
f:id:Infoment:20191230224806p:plain

次いで、これを列方向に１週間分、１列増える毎に１日追加した。
f:id:Infoment:20191230225037p:plain
f:id:Infoment:20191230225121p:plain

では、順序を変えることは可能なのか。まず最初に１行５列作成し、これを行方向に展開するやり方だ。
f:id:Infoment:20191230225539p:plain

実は昨日、最初にこの方法でやろうとして、失敗している。「データ予測」とした場合、増分値は「1」で固定されてしまうのが、その理由だ。
f:id:Infoment:20191230225917p:plain

ということで、上記を踏まえたうえで、昨日までの内容をもう少し一般化してみた。締め括りということで、コメントも追加した。

Function DataSeriesRange(destination_range As Range, _
                Optional dsStep As Variant = 1, _
                Optional dsStop As Variant = 10, _
                Optional dsRowCol As XlRowCol = xlRows, _
                Optional dsType As XlTrendlineType = xlLinear, _
                Optional dsDate As XlDataSeriesDate = xlDay, _
                Optional dsTrend As Boolean = False) As Range

        On Error GoTo er:

        ' フィル機能でデータセット。
        destination_range.DataSeries dsRowCol, dsType, dsDate, dsStep, dsStop, dsTrend
    
    Dim dsStart As Variant
        ' 初期値の取得。
        ' ※データが入力された範囲の取得用。
        dsStart = destination_range.Cells(1).Value
    
    Dim ResizeIndex As Long
        Select Case dsTrend
            ' データ予測ではない場合。
            Case False
                ' 初期値と停止値、増分値から、データがセットされる行または列数を取得。
                ResizeIndex = WorksheetFunction.RoundDown((dsStop - dsStart) / dsStep, 0) + 1
                Select Case dsRowCol
                    Case xlRows
                        Set DataSeriesRange = destination_range.Resize(, ResizeIndex)
                    Case xlColumns
                        Set DataSeriesRange = destination_range.Resize(ResizeIndex)
                End Select
                
            ' データ予測の場合。
            Case True
                Set DataSeriesRange = destination_range
        End Select

        Exit Function
er:
    Set DataSeriesRange = Nothing
End Function

Sub CreateCalendar(specified_date As Date)

    ' カレンダーの表題（yyyy年m月）をセットする範囲。
    With Range("A1").Resize(, 7)
        .Merge
        .Value = Format(specified_date, "yyyy年mm月")
        .HorizontalAlignment = xlCenter
    End With
    
    ' カレンダーの起点となる日付を入力。
    Range("A3") = CalendarFirstDay(specified_date)
    
    ' 全ての日曜日をセット。
    Dim myRng As Range
    Set myRng = DataSeriesRange(destination_range:=Range("A3"), _
                                dsStep:=7, _
                                dsStop:=Range("A1").Value + 35, _
                                dsRowCol:=xlColumns)
                             
    ' 各週の全ての日付をセット。
    Set myRng = DataSeriesRange(destination_range:=myRng.Resize(, 7), _
                                dsTrend:=True)
    
    ' 書式の調整。
    With myRng
        .NumberFormatLocal = "d"
        .Columns(1).Font.Color = vbRed
        .Columns(7).Font.Color = vbBlue
        .ColumnWidth = 2.5
        .HorizontalAlignment = xlCenter
    End With
    
    ' 当月以外について、灰色地で塗り潰し。
    Dim r As Range
        For Each r In myRng
            If Month(r) <> Month(myRng.Cells(2, 1)) Then
                r.Interior.ThemeColor = xlThemeColorDark1
                r.Interior.TintAndShade = -0.149998474074526
            End If
        Next
End Sub

' カレンダーの初日を求める関数　※指定月一日と必ずしも一致しない。
Function CalendarFirstDay(specified_date As Date) As Date
    Dim ThisMonthFirstDay As Date
        ' 指定月一日。
        ThisMonthFirstDay = Format(specified_date, "yyyy/m") & "/1"
        ' 指定月一日の曜日から、カレンダーの初日を求める。
        CalendarFirstDay = ThisMonthFirstDay - Weekday(ThisMonthFirstDay) + 1
End Function