Question

我已经使用VBA从不同的工作表中筛选出值，并且我正在考虑如何最好地设置其格式以提高可读性。我已经合并了相似的值，并希望为每个交替的合并单元格选择相应的行并应用颜色填充。

以下为参考图片：

这是我用来获取当前状态的代码。

Dim lRow As Long
lRow = Cells(Rows.Count, "B").End(xlUp).Row
Application.DisplayAlerts = False
For i = lRow To 7 Step -1
    If Cells(i, 2) = Cells(i - 1, 2) Then
        Range(Cells(i, 2), Cells(i - 1, 2)).Merge
    End If
Next i
Application.DisplayAlerts = True

有没有一种方法可以在循环中插入格式？我也欢迎采用其他方法使表格更具可读性。

PS：我所附的图像仅供参考。我正在使用的实际表具有成排的行和列，因此可读性很重要。

Answer 1

除了合并单元格外，下面的代码可以满足您的要求。与其有效地合并代码，不如将隐藏的重复项目标题隐藏起来。

Option Explicit

Sub FormatData()
    ' 28 Feb 2019

    Const CaptionRow As Long = 1
    Const FirstDataRow As Long = 3              ' assuming row 2 to contain subtitles
    Const FirstDataClm As String = "B"          ' change as appropriate
    Const DescClm As String = "D"               ' change as appropriate

    Dim Desc As Variant, PrevDesc As Variant
    Dim Col() As Variant, ColIdx As Boolean
    Dim FontCol As Long
    Dim Rng As Range
    Dim Rl As Long, Cl As Long                  ' last Row / Column
    Dim R As Long

    Rl = Cells(Rows.Count, DescClm).End(xlUp).Row
    Cl = Cells(CaptionRow, Columns.Count).End(xlToLeft).Column
    Col = Array(15261367, 15986394)             ' sky, pale: change as required
    FontCol = Cells(FirstDataRow, FirstDataClm).Font.Color
    Application.ScreenUpdating = False

    For R = FirstDataRow To Rl
        Desc = Cells(R, DescClm).Value
        If Desc = PrevDesc Then
            Set Rng = Rng.Resize(Rng.Rows.Count + 1)
        Else
            If Not Rng Is Nothing Then
                SetColouring Rng, DescClm, Col(Abs(ColIdx)), FontCol
                ColIdx = Not ColIdx
            End If
            Set Rng = Range(Cells(R, FirstDataClm), Cells(R, Cl))
        End If
        PrevDesc = Desc
    Next R

    SetColouring Rng, DescClm, Col(Abs(ColIdx)), FontCol
    Application.ScreenUpdating = True
End Sub

Private Sub SetColouring(Rng As Range, _
                         ByVal C As String, _
                         ByVal Col As Long, _
                         ByVal Fcol As Long)
    ' 28 Feb 2019

    Dim R As Long

    With Rng
        .Interior.Color = Col
        .Font.Color = Fcol
        For R = 2 To .Rows.Count
            .Cells(R, Columns(C).Column - .Column + 1).Font.Color = Col
        Next R
    End With
End Sub

在代码顶部有一些可以修改的常量。还要注意，您在工作表中使用的字体颜色假定是在常量的指定位置在工作表的第一个使用的单元格中找到的。

观察到整个代码都在ActiveSheet上运行。我强烈敦促您更改该位并指定一个工作表，最好同时指定其名称和工作表所在的位置。如果您定期使用上面发布的代码只是时间问题，那么将其应用于损坏的工作表之前结果。

VBA：循环通过合并的单元格并将格式应用于备用行

1 个答案: