Question

我有一些代码，当单元格值更改时，它将插入空白行。如何将其修改为而不是插入空白行以添加粗底边框？每当B列中的值更改时，边框就会从A列转到AB列

关于我的浏览器的代码，请快速注意一下，代码按钮将不会显示

Sub InsertRows()
Dim lastRow As Long
Dim rowPtr As Long

lastRow = Range("B" & Rows.Count).End(xlUp).Row
For rowPtr = lastRow To 2 Step -1
If Not IsEmpty(Range("B" & rowPtr)) Then
If Range("B" & rowPtr) <> Range("B" & rowPtr - 1) Then
Range("B" & rowPtr).EntireRow.Insert
End If
End If
Next

End Sub

谢谢

Answer 1

尝试：

Range("B" & rowPtr).Select
With Selection.Borders(xlEdgeBottom)
    .Weight = xlThick
End With

Answer 2

基本上，将Range("B" & rowPtr).EntireRow.Insert代码替换为添加边框的代码！

您的代码已重构，还有其他tweeks

Sub BorderRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim rowPtr As Long
    Dim columnsToBorder As Long

    Set ws = ActiveSheet
    columnsToBorder = 28
    With ws
        lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
        'Optional, clear existing borders
        With .UsedRange.Resize(, columnsToBorder)
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With

        For rowPtr = 2 To lastRow
            If Not IsEmpty(.Cells(rowPtr, 2)) Then
                If .Cells(rowPtr, 2).Value <> .Cells(rowPtr - 1, 2).Value Then
                    With .Cells(rowPtr, 1).Resize(1, columnsToBorder).Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlThick
                    End With
                End If
            End If
        Next

        'Optional, add borber to last row
        With .Cells(lastRow, 1).Resize(1, columnsToBorder).Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThick
        End With

    End With
End Sub

单元格值更改时，如何在行范围内添加粗底边框？

2 个答案: