Excel VBA 范围合并单元格和偏移量
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18731252/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA Range Merge Cells and offset
提问by Kairan
This can be copied and pasted directly into excel module and run
这个可以直接复制粘贴到excel模块中运行
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.
问题出在 AddCalendarMonthHeader() 月份单元格应该合并、居中和设置样式，但事实并非如此。我唯一的想法是 Main() 中的 range.offset() 正在影响它，但我不知道为什么或如何修复它。
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
回答by manimatters
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)
回答by enderland
Woah, I'm really surprised this works at all! Rangeis 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.
哇，我真的很惊讶这竟然有效！Range是 VBA 和 Excel 中的关键字，因此我很惊讶您能够毫无问题地将其用作变量名。
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:$H i:1
Range updated00: $B:$H
Range updated0: $B:$H
Range updated1: $B
So after the second offset, your rangevariable is only a single cell, which means it cannot be merged. Interestingly this is the case even if your rangevariable is renamed.
因此，在第二个偏移量之后，您的range变量只是一个单元格，这意味着它无法合并。有趣的是，即使您的range变量被重命名，情况也是如此。
Now, this behavior ONLY occurs when the .Mergefunction from your method AddCalendarMonthHeaderis invoked (commenting this out shows your range addresses are accurate for each iteration).
现在，这种行为仅在调用.Merge您的方法中的函数时发生AddCalendarMonthHeader（注释掉这一点表明您的范围地址对于每次迭代都是准确的）。
It seems this is directly caused by using .Merge- a fair bit of messing around on my part indicates even the following code will stillhave the same problem (note: I renamed your rangevariable to mrange):
这似乎是由使用直接引起的.Merge- 我的一些混乱表明即使以下代码仍然存在相同的问题（注意：我将您的range变量重命名为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
TL; 博士
Using .Mergecauses abnormal functionality with VBA when using .Offset. I would recommend trying to modify your code to not use merge, perhaps as Alexandersays or some other formatting strategy.
使用.Merge使用时，会导致VBA功能异常.Offset。我建议尝试修改您的代码以不使用合并，也许正如亚历山大所说或其他一些格式化策略。
