[英]Excel VBA Autofill Destination
需要以下代碼行的幫助:
.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列,
因此您必須在列數是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
輸出(法文):
您是否嘗試過將Type
添加到Autofill
?
如:
Type:=xlFillDefault
.Range("A1:G1").AutoFill Destination:=.Range("A1:U1"),Type:=xlFillDefault
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.