Excel VBA 自动填充目标

Posted 2023-02-24

【中文标题】Excel VBA 自动填充目标

【英文标题】：Excel VBA Autofill Destination

【发布时间】：2017-02-16 10:15:31

【问题描述】：

在这行代码方面需要一些帮助：

.Range("A1:G1").AutoFill Destination:=.Range("A1:U1")

我正在尝试自动制作日历。如果我将范围更改为除A1:U1 之外的任何值，则代码将无法编译。我想将范围扩大到A1:AE1

它卡住而不在那里编译的任何原因？

谢谢！

Sub CreateCalendar()
Dim lMonth As Long
Dim strMonth As String
Dim rStart As Range
Dim strAddress As String
Dim rCell As Range
Dim lDays As Long
Dim dDate As Date
    'Add new sheet and format


    ActiveWindow.DisplayGridlines = True
        With Cells
            .ColumnWidth = 6#
            .Font.Size = 8
        End With
    'Create the Month headings
    For lMonth = 1 To 12
            Select Case lMonth
                    Case 1
                        strMonth = "January"
                        Set rStart = Range("A1")
                    Case 2
                        strMonth = "February"
                        Set rStart = Range("A3")
                    Case 3
                        strMonth = "March"
                        Set rStart = Range("A5")
                    Case 4
                        strMonth = "April"
                        Set rStart = Range("A7")
                    Case 5
                        strMonth = "May"
                        Set rStart = Range("A9")
                    Case 6
                        strMonth = "June"
                        Set rStart = Range("A11")
                    Case 7
                        strMonth = "July"
                        Set rStart = Range("A13")
                    Case 8
                        strMonth = "August"
                        Set rStart = Range("A15")
                    Case 9
                        strMonth = "September"
                        Set rStart = Range("A17")
                    Case 10
                        strMonth = "October"
                        Set rStart = Range("A19")
                    Case 11
                        strMonth = "November"
                        Set rStart = Range("A21")
                    Case 12
                        strMonth = "December"
                        Set rStart = Range("A23")
            End Select
            'Merge, AutoFill and align months
            With rStart
                .Value = strMonth
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = 6
                .Font.Bold = True
                    With .Range("A1:G1")
                        .Merge
                        .BorderAround LineStyle:=xlContinuous
                    End With
                **.Range("A1:G1").AutoFill Destination:=.Range("A1:U1")**
            End With
    Next lMonth
     'Pass ranges for months
     For lMonth = 1 To 12
        strAddress = Choose(lMonth, "A2:AE2", "A4:AE4", "A6:AE6", _
                            "A8:AE8", "A10:AE10", "A12:AE12", _
                            "A14:AE14", "A16:AE16", "A18:AE18", _
                            "A20:AE20", "A22:AE22", "A24:AE24")
        lDays = 0
        Range(strAddress).BorderAround LineStyle:=xlContinuous
        'Add dates to month range and format
        For Each rCell In Range(strAddress)
            lDays = lDays + 1
            dDate = DateSerial(Year(Date), lMonth, lDays)
                If Month(dDate) = lMonth Then ' It's a valid date
                    With rCell
                        .Value = dDate
                        .NumberFormat = "ddd dd"
                    End With
                End If
        Next rCell
    Next lMonth
    'add con formatting
     With Range("A1:AE28")
           .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=TODAY()"
           .FormatConditions(1).Font.ColorIndex = 2
           .FormatConditions(1).Interior.ColorIndex = 1
    End With
End Sub

【问题讨论】：

您收到的实际错误信息是什么？

它不起作用的原因是因为当您尝试自动填充时AE不适合合并的单元格范围，如果您选择AB或AI它将起作用..AE是第31列，您已合并7单元格，31 不会被 7 整除（至少不是整数）.. 选择一个能被 7 整除的单元格，你就可以了

我仍然收到 1004 错误。我可能没有解释清楚，我希望在 28-31 列之间合并（最大），作为日期之间的分隔符。

@Collin ：看看我的回答。您是否只想合并到该月的最后一个日期？还是要有一个矩形阵列？

您提出的实际问题几乎与您的原始帖子完全无关。错误消息的原因已解释。您真正需要帮助的内容仅在回应其中一个答案的评论中得到部分解释。请彻底检查问题以准确询问您要达到的目标。自动填充将不参与要合并的其他分隔字段。

【参考方案1】：

尝试使用 AE1 运行您的代码，收到此错误：

这实际上是运行时错误，而不是编译错误。 （编译错误甚至不会让您进入例程，可能是由于未声明的变量或无效的语法）

当使用合并单元格填充时，您需要填充合并单元格数量的偶数倍。合并 A1:G1 后，您需要合并到 AB 或 AI 为 7 的偶数倍。

【参考方案2】：

正如多次解释的那样，问题是A:G 是 7 列， 因此，您必须在包含 7 倍数的列的范围内使用 AutoFill！

A:AE 上的工作解决方案优化代码：

Sub CreateCalendar()
Dim wS As Worksheet
Dim lMonth As Long
Dim DateMidMonth As Date
Dim LastDayOfMonth As Integer
Dim strMonth As String
Dim rStart As Range
Dim Row1 As Integer
Dim rCell As Range

ActiveWindow.DisplayGridlines = True

    'Add new sheet and format
    Set wS = ThisWorkbook.Sheets.Add

    With wS
        With .Cells
            .ColumnWidth = 6#
            .Font.Size = 8
        End With '.Cells

        For lMonth = 1 To 12
            DateMidMonth = CDate(lMonth & "/15/2017")
            LastDayOfMonth = Day(Application.WorksheetFunction.EoMonth(DateMidMonth, 0))
            strMonth = Format(DateMidMonth, "MMMM")
            Row1 = 1 + (lMonth - 1) * 2

            '''Create the Month headings
            Set rStart = .Range("A" & Row1)
            Set rStart = .Range(rStart, rStart.Offset(0, LastDayOfMonth - 1))
            '''Merge, AutoFill and align months
            With rStart
                .Merge
                .Value = strMonth
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = 6
                .Font.Bold = True
                .BorderAround LineStyle:=xlContinuous

                '''Create days
                With .Offset(1, 0).Resize(1, .Columns.Count)
                    .BorderAround LineStyle:=xlContinuous
                    .NumberFormat = "ddd dd"
                    'Add dates to month range
                    For Each rCell In .Cells
                        rCell.Value = DateSerial(Year(Date), lMonth, rCell.Column)
                    Next rCell
                End With '.Offset(1, 0).Resize(1, .Columns.Count)
            End With 'rStart
        Next lMonth

        '''add conditional formatting
         With .Range("A1:AE28")
               .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=TODAY()"
               .FormatConditions(1).Font.ColorIndex = 2
               .FormatConditions(1).Interior.ColorIndex = 1
        End With '.Range("A1:AE28")
    End With 'wS
End Sub

输出（法语）：

【讨论】：

您好，感谢您的帮助。我知道它会编译，但是我希望几个月只有一次。要合并的 28-31 列。对不起，如果我没有解释清楚。是否有任何解决方法而不是将其除以 7？

@Collin ：当然，只是每个人都认为每周 7 天之类的 7 列是自愿的！给我一分钟编辑！ ;)

@Collin：试一试！ ;)

一个小请求，如何在Days行后添加几个空白行（4）？我应该添加哪一行来进行修改？

@Collin ：将 Row1 = 1 + (lMonth - 1) * 2 更改为 Row1 = 1 + (lMonth - 1) * 6

【参考方案3】：

您是否尝试将Type 添加到您的Autofill？

如：

Type:=xlFillDefault 

.Range("A1:G1").AutoFill Destination:=.Range("A1:U1"),Type:=xlFillDefault 

【讨论】：

这没有用，因为这是隐式使用的默认属性，更重要的是因为它正在处理合并的单元格，所以它应该是这些单元格长度的倍数