フィルをマクロで操作し、その戻り値をRangeとする関数（日付対応）

先日からフィルをマクロで操作したうえで、その戻り値をRangeとする
関数の作成を試みている。
infoment.hatenablog.com

今日は、日付対応に取り組んでみる。

先日作成した際、何も考えずに停止値の型を「Long」（長整数型）にした。しかし考えてみると、これでは日付に対応できない。例えば、以下でテストしてみる。

Sub test()
    DataSeriesRange Range("A1"), , "2020/1/1", xlColumns
End Sub

すると当然の如く、"2020/1/1"と型が一致しないので怒られる。

では、引数「dsStop」の型をVariantにすればよいのか。文字列と日付は型が違うと怒られそうだが、さてどうだろう。

・・・あっさり解決してしまった。
という訳で、微調整した「現時点での最新版」がコチラ。

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

日付問題も解決したので、今度は使い方を考えてみた。
例えば、こんなのはどうだろう。

1. ５行７列の範囲について、左上に起点となる日付（日曜日）を入力。
2. 行方向に、七日ずつ増加する連続データを作成。
3. 列方向に、一日ずつ増加する連続データを作成。
4. 全体を「日」表示にする。
5. 日曜日列の文字を赤色に着色。
6. 土曜日列の文字を青色に着色。
7. ２行１列目と「月」が違うセルは全て、当月ではないので灰色で塗り潰し。

Sub test()
    Range("A1") = "2019/12/29"
    
    Dim myRng As Range
    Set myRng = DataSeriesRange(destination_range:=Range("A1"), _
                                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

結果、このようになった。

今日は、ここで時間切れ。明日に続きます。

参考まで。