[英]Excel VBA Autofill Destination
Need some help with this line of code: 需要以下代码行的帮助:
.Range("A1:G1").AutoFill Destination:=.Range("A1:U1")
I'm trying to automate making a calendar. 我正在尝试自动制作日历。 The code won't compile if I change the range to any value except A1:U1
. 如果将范围更改为除A1:U1
之外的任何值,则代码不会编译。 I would like to extend the range to A1:AE1
我想将范围扩展到A1:AE1
Any reason why it's stuck and not compiling there? 有什么原因会卡住而不在此处编译?
Thanks! 谢谢!
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
Tried running your code with AE1, got this error: 尝试使用AE1运行代码,出现此错误:
This is actually a run-time error, not a compile error. 这实际上是运行时错误,而不是编译错误。 (A compile error won't even let you enter the routine, possibly due to an undeclared variable or invalid syntax) (可能由于未声明的变量或无效的语法,导致编译错误甚至不允许您进入例程)
When filling across with merged cells, you need to a fill an even multiple of the number of merged cells. 当填充合并的单元格时,您需要填充合并单元格数量的偶数倍。 With A1:G1 merged, you need to merge to either AB or AI to be an even multiple of 7. 合并A1:G1后,您需要合并到AB或AI以等于7的偶数倍。
As explain many times, the issue is that A:G
is 7 columns, 多次解释,问题是A:G
为7列,
so you'll have to use AutoFill
on a range that has a number of columns that is a multiple of 7! 因此您必须在列数是7的倍数的范围内使用AutoFill
!
Optimized code for Working solution on A:AE
: 针对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
Output (in French) : 输出(法文):
Have you tried adding a Type
to your Autofill
? 您是否尝试过将Type
添加到Autofill
?
Such as: 如:
Type:=xlFillDefault
.Range("A1:G1").AutoFill Destination:=.Range("A1:U1"),Type:=xlFillDefault
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.