Question

我需要添加代码，以便在插入空白的彩色行时，它有一个顶部和底部黑色边框：

Sub AddBlankRows()

Dim iRow As Integer, iCol As Integer
Dim oRng As Range

Set oRng = Range("a1")

iRow = oRng.Row
iCol = oRng.Column

Do

'
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
    Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown
    Cells(iRow + 1, iCol).EntireRow.Merge
    Cells(iRow + 1, iCol).EntireRow.Interior.Color = RGB(204, 204, 204)

    iRow = iRow + 2
Else
    iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, iCol).Text = ""
'
End Sub

Answer 1

如何用以下代码替换代码：

Sub AddBlankRows()

Dim iRow As Integer, iCol As Integer
Dim oRng As Range

Set oRng = Range("a1")

iRow = oRng.Row
iCol = oRng.Column

Do
    If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
        Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown
        Cells(iRow + 1, iCol).EntireRow.Merge
        Cells(iRow + 1, iCol).EntireRow.Interior.Color = RGB(204, 204, 204)
        With Cells(iRow + 1, iCol).EntireRow.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Cells(iRow + 1, iCol).EntireRow.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        iRow = iRow + 2
    Else
        iRow = iRow + 1
    End If

Loop While Not Cells(iRow, iCol).Text = ""
End Sub

VBA添加顶部和底部寄宿生

1 个答案: