Question

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

见下面第5行和第6行

我的代码合并了具有共同月份的单元格，但是对于第6行，我想格式化每个其他合并单元格，使其填充为黑色，字体为白色，并将公式放入A6并自动填充右边即第二个合并单元格在2月下的第6行是=透水细胞（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

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

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

2 个答案: