Excel VBA自动填充目的地

这行代码需要一些帮助:

.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 

多次解释,问题是A:G是7列,
所以你必须使用AutoFill范围的列数是7的倍数!

A:AE上工作解决scheme的优化代码:

 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 

输出(法文):

在这里输入图像说明

试过用AE1运行你的代码,得到这个错误:

在这里输入图像说明

这实际上是一个运行时错误,而不是编译错误。 (编译错误甚至不会让你进入例程,可能是由于未声明的variables或无效的语法)

在填充合并单元格时,需要填充合并单元格数量的偶数倍。 与A1:G1合并,您需要合并到AB或AI以成为7的倍数。

你有没有尝试添加一个Type到你的Autofill

如:

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