Excel VBA根据列名称和单元格值将边框分配给组

Question

我有以下代码，我想执行以下操作：

根据名称（例如“ Company”）浏览特定的一列，并根据该列中的值（例如“ CompanyA”，“ CompanyB”，“ CompanyC”等）将边框更改为厚框边框。 这意味着“公司A”（50行）将获得边框，而“公司B”（5行）将获得边框，依此类推。

能做到吗？ 提前输入！

Sub DrawBorders() 

Dim rCell As Range 
Dim rRange As Range 

Set rRange = Range("A1", Range("A65536").End(xlUp)) 

For Each rCell In rRange 
    If Not IsEmpty(rCell) And _ 
    Not IsEmpty(rCell.Offset(1, 0)) Then 
        With rCell 
            If .Value <> .Offset(1, 0).Value Then 
                With .EntireRow.Borders(xlEdgeBottom) 
                    .LineStyle = xlContinuous 
                    .Weight = xlMedium 
                    .ColorIndex = xlAutomatic 
                End With 
            End If 
        End With 
    End If 
Next rCell 

End Sub 

Answer 1

我已调整代码以适应您的要求。 这只会在所需公司类型周围设置边界。 您可能需要根据要处理的数据向IF语句添加更多错误捕获。

Sub DrawBoarders()
    Dim rCell As Range
    Dim rRange As Range
    Dim Prev As String
    Dim MyCell As String
    Prev = ""

    Set rRange = Range("A2", Range("A65536").End(xlUp))
    Dim SpecificCompany(3) As String 'Using 3 companies (Company A, B, & C)
    'Array of desired company names
    SpecificCompany(0) = "CompanyA"
    SpecificCompany(1) = "CompanyB"
    SpecificCompany(2) = "CompanyC"


    If IsInArray(Range("A1"), SpecificCompany) Then 'Check 1st row
            With Range("A1").EntireRow.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            End With
    End If

    For Each rCell In rRange
        If IsInArray(rCell.Value, SpecificCompany) And rCell.Value <> rCell.Offset(-1, 0).Value Then
            With rCell.EntireRow.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            End With
        End If
        If Not IsEmpty(rCell) And _
        Not IsEmpty(rCell.Offset(1, 0)) Then
        If rCell.Value <> rCell.Offset(1, 0).Value Then
            With rCell.EntireRow.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
            End With
        End If
        End If
    Next rCell
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function