Question

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

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

可以这样做吗？提前Ty！

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

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

1 个答案: