使用 VBA 在 Excel 中选择多个可变单元格区域以绘制边框答案

【问题标题】：Selecting multiple variable cell ranges in Excel with VBA to draw borders使用 VBA 在 Excel 中选择多个可变单元格区域以绘制边框
【发布时间】：2015-10-15 17:02:34
【问题描述】：

我有一个自动接收从电子表格另一部分提取的数据的选项卡。报告的数据始终包含三列：A 列有任务描述，B 列有人工编号，C 列有费用编号。 Col F 有一个数字，表示该部分中的行数（每次都会不同，但它与提取一起出现 - 无需计算）。

我只想按列在每个部分周围绘制边框。因此，如果我手动操作，我选择 A2:A7 并选择外边框。然后我选择 B2:B7 并做同样的事情。然后 C2:C7 并重复。我知道涉及多少行，因为该数字在 F 列中。

然后我转到下一部分并做同样的事情，但行数可能会不同，但在 F 列中标识。

将重复该过程，直到所有部分都被概述。可能有 3 个部分，或者 20 个。我想我可以根据 F 列中的数据条目数循环序列。

以下是之前和之后的链接：

Excel border automation - before

Excel border automation - after

【问题讨论】：

标签： vba excel

【解决方案1】：

不要为此使用 VBA - 请改用条件格式。转到条件格式 -> 添加新规则 -> 自定义公式，然后选择 A、B 和 C 列，键入以下公式：

=NOT(ISBLANK(A1))

这将查看这些列中的每个单独的单元格。如果这些单元格中的任何一个具有任何值，则上面的公式将解析为 TRUE。这意味着您指定的条件格式规则将适用。然后在规则中添加格式，以便在单元格的右侧和左侧有一个边框。

然后添加另一条规则：

=AND(NOT(ISBLANK(A1)),ISBLANK(A2))

当一个特定的单元格有一个值但它下面的那个没有时，这将解析为 TRUE。添加使底部边框可见的格式。

【讨论】：

【解决方案2】：

检查一下。这是sample workbook

Sub Button1_Click()
    Dim findrow As Long, findrow2 As Long
    Dim rw1 As Long, rw2 As Long, i As Integer
    Dim Brng As Range

    On Error GoTo errhandler
    x = WorksheetFunction.CountIf(Range("A:A"), "*Phase*")
    rw1 = Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To x + 1
        If findrow <> 0 Then
            findrow = findrow2
        Else
            findrow = Range("A1:A" & rw1 + findrow2).Find("*Phase*", lookat:=xlWhole).Row + rw2
        End If
        rw2 = findrow + 1
        If i = x + 1 Then
            findrow2 = rw1 + 1
        Else
            findrow2 = Range("A" & rw2 & ":A" & rw1).Find("*Phase*", lookat:=xlWhole).Row
        End If
        Set Brng = Range("A" & findrow & ":A" & findrow2 - 1)
        With Brng
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
        End With
        With Brng.Offset(0, 1)
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
        End With
        With Brng.Offset(0, 2)
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
        End With
    Next i

    Exit Sub

errhandler:
    MsgBox "No Cells containing specified text found"

End Sub

【讨论】：