Excel的VBA自動填充目標

需要一些幫助，這行代碼：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

來源

2017-02-16 Collin

那是什麼，你得到實際的錯誤信息？ – Michael

它不會工作，是因爲AE犯規適合在合併單元格範圍內，當你嘗試自動填充，如果你選擇AB或AI將工作.. AE是列31，你已經合併了7個細胞的原因，由7月31日犯規鴻溝（至少不是全部數字）..選擇一個可以被7整除的單元格，並且你很好走 –

我仍然收到1004錯誤。我可能無法解釋清楚，我想要在28-31列之間合併（最大），以便在日期之間進行分隔。 – Collin

作爲解釋很多次，問題是A:G是7列，
所以你必須使用AutoFill的列數是7的倍數！

對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

輸出（法語）：

來源

2017-02-16 11:02:45 R3uK

喜的倍數，感謝您的幫助。我知道它會編譯，但我希望幾個月只是一次。 28-31列將被合併。對不起，如果我沒有解釋清楚。有沒有任何解決方法，而不是7分？ – Collin

@Collin：當然，只是每個人都認爲在一週內有7個專欄像7天一樣是自願的！給我一分鐘編輯！ ;） – R3uK

@Collin：試一試！ ;） – R3uK

您是否試過在Autofill上添加Type？

如：

Type:=xlFillDefault 

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

來源

2017-02-16 10:20:56

這會不會是有用的，因爲這是它隱含更重要的是使用，因爲它正在與合併單元格的默認屬性，因此它被假設是這些細胞的長度 – R3uK

試圖與AE1運行代碼，得到這個錯誤：

這實際上是一個運行時錯誤，而不是編譯錯誤。（編譯錯誤甚至不會讓你進入例程，可能是由於未聲明的變量或無效語法）

當填充合併的單元格時，需要填充偶數單元格的偶數倍。隨着A1：G1合併，您需要合併要麼AB或AI是一個偶數倍7.

來源

2017-02-16 10:23:47 Michael

Excel的VBA自動填充目標

回答

相關問題