Excel VBA Range Merge Cells and offset

问题:

This can be copied and pasted directly into excel module and run

The issue is in the AddCalendarMonthHeader() The month cell should be merged, centered, and style but it is not. My only thought is the range.offset() in Main() is affecting it but I dont know why or how to fix it.

Public Sub Main()      'Remove existing worksheets     Call RemoveExistingSheets      'Add new worksheets with specified names     Dim arrWsNames() As String     arrWsNames = Split("BDaily,BSaturday", ",")     For Each wsName In arrWsNames         AddSheet (wsName)     Next wsName      'Format worksheets columns     For Each ws In ThisWorkbook.Worksheets         If ws.name <> "How-To" Then             Call ColWidth(ws)         End If     Next ws      'Insert worksheet header     For Each ws In ThisWorkbook.Worksheets         If ws.name <> "How-To" Then             Call AddSheetHeaders(ws, 2013)         End If     Next ws      'Insert calendars     For Each ws In ThisWorkbook.Worksheets         If ws.name <> "How-To" Then             Call AddCalendars(ws, 2013)         End If     Next ws   End Sub            Public Sub AddCalendars(ByVal ws As Worksheet, year As Integer)     Dim startCol As Integer, startRow As Integer      Dim month1 As Integer, month2 As Integer     month1 = 1     month2 = 2         Dim date1 As Date         Dim range As range         Dim rowOffset As Integer, colOffset As Integer          Set range = ws.range("B1:H1")      'Loop through all months     For i = 1 To 12 Step 2         Set range = range.Offset(1, 0)         date1 = DateSerial(year, i, 1)          'Add month header         Call AddCalendarMonthHeader(monthName(i), range)          'Add weekdays header         Set range = range.Offset(1, 0)         Call AddCalendarWeekdaysHeader(ws, range)          'Loop through all days in the month         'Add days to calendar '        For j = 1 To DaysInMonth(date1)          Dim isFirstWeek As Boolean: isFirstWeek = True         Dim firstWeekOffset As Integer: firstWeekOffset = Weekday(DateSerial(year, i, 1))          For j = 1 To 6 'Weeks in month             Set range = range.Offset(1, 0)             range.Cells(1, 1).Value = "Week " & j             For k = 1 To 7 'Days in week                 If isFirstWeek Then                     isFirstWeek = False                     k = Weekday(DateSerial(year, i, 1))                 End If             Next k 'Exit For 'k         Next j 'Exit For 'j 'Exit For 'i         Set range = range.Offset(1, 0)     Next i End Sub Public Sub AddCalendarMonthHeader(month As String, range As range)     With range         .Merge         .HorizontalAlignment = xlCenter '       .Interior.ColorIndex = 34         .Style = "40% - Accent1"         '.Cells(1, 1).Font = 10         .Font.Bold = True         .Value = month     End With End Sub Public Sub AddCalendarWeekdaysHeader(ws As Worksheet, range As range)     For i = 1 To 7         Select Case i             Case 1, 7                 range.Cells(1, i).Value = "S"             Case 2                 range.Cells(1, i).Value = "M"             Case 3, 5                 range.Cells(1, i).Value = "T"             Case 4                 range.Cells(1, i).Value = "W"             Case 6                 range.Cells(1, i).Value = "F"         End Select         range.Cells(1, i).Style = "40% - Accent1"     Next i End Sub Public Function DaysInMonth(date1 As Date) As Integer     DaysInMonth = CInt(DateSerial(year(date1), month(date1) + 1, 1) - DateSerial(year(date1), month(date1), 1)) End Function         'Remove all sheets but the how-to sheet Public Sub RemoveExistingSheets()     Application.DisplayAlerts = False     On Error GoTo Error:     For Each ws In ThisWorkbook.Sheets         If ws.name <> "How-To" Then             ws.Delete         End If     Next ws  Error: Application.DisplayAlerts = True End Sub 'Add a new sheet to end with given name Public Sub AddSheet(name As String)     ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).name = name End Sub 'Set sheet column widths Public Sub ColWidth(ByVal ws As Worksheet)     Application.ScreenUpdating = False     On Error GoTo Error:         Dim i As Long         For i = 1 To 26            ws.Columns(i).ColumnWidth = 4.43         Next i Error:     Application.ScreenUpdating = True End Sub Public Sub AddSheetHeaders(ByVal ws As Worksheet, year As Integer)     Dim range As range     Set range = ws.range("B1", "P1")     With range         .Merge         .HorizontalAlignment = xlCenter         .Font.ColorIndex = 11         .Font.Bold = True         .Font.Size = 26          .Value = year     End With End Sub 

回答1:

The issue you are having is that after the first range is merged, the length of the range becomes one column on offsetting. So after that, the next ranges are messed up.

    For i = 1 To 12 Step 2         Set range = range.Offset(1, 0) ' Range is 7 columns wide          date1 = DateSerial(year, i, 1)          'Add month header         Call AddCalendarMonthHeader(MonthName(i), range) ' We merge and range is now 1 column          'Add weekdays header         Set range = range.Offset(1, 0) ' Fix here to make it 7 columns . . . 

To Fix this, all you need to do is change the size of the range before adding the weekdays header

'Add weekdays header Set range = range.Offset(1, 0).Resize(1, 7) 

回答2:

Woah, I'm really surprised this works at all! Range is a keyword in VBA and Excel, so it is very surprising to me you are able to use that as a variable name without problems.

You can troubleshoot problems like this a lot easier by adding a debug statement:

        'Add month header         Debug.Print "Range Address: " & range.Address & vbTab & "i:" & i         Call AddCalendarMonthHeader(MonthName(i), range)         Debug.Print "Range updated00: " & range.Address          'Add weekdays header         Debug.Print "Range updated0: " & range.Address         Set range = range.Offset(1, 0) `<---- this is the line where the Offset loses the entire row         Debug.Print "Range updated1: " & range.Address 

This results in the following:

Range Address: $B$2:$H$2    i:1 Range updated00: $B$2:$H$2 Range updated0: $B$2:$H$2 Range updated1: $B$3 

So after the second offset, your range variable is only a single cell, which means it cannot be merged. Interestingly this is the case even if your range variable is renamed.

Now, this behavior ONLY occurs when the .Merge function from your method AddCalendarMonthHeader is invoked (commenting this out shows your range addresses are accurate for each iteration).

It seems this is directly caused by using .Merge - a fair bit of messing around on my part indicates even the following code will still have the same problem (note: I renamed your range variable to mrange):

        Debug.Print "Range updated First: " & mrange.Address         Set mrange = mrange.Offset(1, 0)         date1 = DateSerial(year, i, 1)          'Add month header         Debug.Print "Range Address: " & mrange.Address & vbTab & "i:" & i         Dim mStr As String         mStr = mrange.Address         AddCalendarMonthHeader MonthName(i), mrange         Debug.Print "Range updated00: " & mrange.Address          'Add weekdays header         Debug.Print "Range updated0: " & mrange.Address         Set mrange = range(mStr)         Set mrange = mrange.Offset(1, 0)         Debug.Print "Range updated1: " & mrange.Address 

---

TL;DR

Using .Merge causes abnormal functionality with VBA when using .Offset. I would recommend trying to modify your code to not use merge, perhaps as Alexander says or some other formatting strategy.

文章来源: Excel VBA Range Merge Cells and offset