在Excel VBA中，如何格式化每一个其他合并的单元格？

我有一些代码将52列合并到特定年份的月份中。

请参阅下面的第5行和第6行

我的代码合并的单元格有一个共同的月份，但是第6行我想格式化每隔一个合并的单元格，所以它是填充黑色，字体是白色的公式被放入A6和自动填充权，即行第二个合并的单元格6 2月份下=上个月（1月下）-1。

下面的代码由用户CMArg提供，几乎实现了我所要做的…

结果是这样的

Dim TempRange, TempRange2 As Range Dim a, c, i, z As Integer Sub MergeAndPaint() z = 60 'the first value in row 6 a = 1 For i = 1 To 260 '260 is number of columns up to IZ If Worksheets("MASTER").Cells(5, i).Value <> Worksheets("MASTER").Cells(5, i + 1).Value Then Set TempRange = Range(Worksheets("MASTER").Cells(5, a), Worksheets("MASTER").Cells(5, i)) Set TempRange2 = Range(Worksheets("MASTER").Cells(6, a), Worksheets("MASTER").Cells(6, i)) With TempRange .Merge .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With With TempRange2 .Merge .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Value = z If a Mod 2 = 0 Then .Interior.Pattern = xlSolid .Interior.PatternColorIndex = xlAutomatic .Interior.ThemeColor = xlThemeColorLight1 .Font.ThemeColor = xlThemeColorDark1 End If End With a = i + 1 z = z - 1 End If Next End Sub 

Answer 1

我认为这个代码会执行你想要实现的，但是更短更清晰。 查看新的EDITED代码。

  Dim TempRange, TempRange2 As Range Dim a, i, z, d As Integer Sub MergeAndPaint() z = 60 'the first value in row 6 a = 1 'variable used for setting ranges d = 2 'for counting odd and even For i = 1 To 260 '260 is number of columns up to IZ If Worksheets("MASTER").Cells(5, i).Value <> Worksheets("MASTER").Cells(5, i + 1).Value Then Set TempRange = Range(Worksheets("MASTER").Cells(5, a), Worksheets("MASTER").Cells(5, i)) Set TempRange2 = Range(Worksheets("MASTER").Cells(6, a), Worksheets("MASTER").Cells(6, i)) With TempRange .Merge .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With With TempRange2 .Merge .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Value = z If d Mod 2 = 0 Then .Interior.Pattern = xlSolid .Interior.PatternColorIndex = xlAutomatic .Interior.ThemeColor = xlThemeColorLight1 .Font.ThemeColor = xlThemeColorDark1 End If End With d = d + 1 a = i + 1 z = z - 1 End If Next End Sub 

Answer 2

你可以试试这个

 Sub MergeAndPaint2() Dim i As Long With Worksheets("MASTER").Rows(5).SpecialCells(xlCellTypeConstants, xlTextValues) .Offset(1).FormulaR1C1 = "=60-counta(R[-1]C1:R[-1]C)+1" For i = 1 To .Areas.Count - 1 Call FormatWeek(Range(.Areas(i), .Areas(i + 1).Offset(, -1)).Resize(2)) Next i If .Areas.Count > 1 Then Call FormatWeek(Range(.Areas(i), .Areas(i).Offset(, 3)).Resize(2)) End With With Worksheets("MASTER").Rows(5).SpecialCells(xlCellTypeConstants, xlTextValues).Offset(1) .Value = .Value End With End Sub Sub FormatWeek(rng As Range) With rng .Merge (True) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter With .cells(2, 1) If .Value Mod 2 = 0 Then .Interior.Pattern = xlSolid .Interior.PatternColorIndex = xlAutomatic .Interior.ThemeColor = xlThemeColorLight1 .Font.ThemeColor = xlThemeColorDark1 End If End With End With End Sub 

它适用于月份名称之间的任何间隔