Question

我正在使用此代码，效果很好，但是它弄乱了表中的条件格式。是否可以通过VBA在表中插入新行而不影响条件格式？

Public Sub insertRowBelow()
ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End Sub

Answer 1

这将起作用：

Public Sub insertRowBelow()

ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteAllMergingConditionalFormats
ActiveCell.Offset(1).EntireRow.Clear
Application.CutCopyMode = False


End Sub

Answer 2

尝试：

Option Explicit

Sub test()

    'Change Sheet name if needed
    With ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1")

        If Not Intersect(ActiveCell, .DataBodyRange) Is Nothing Then
            'Change table name if needed - Insert one row above active cell
            .ListRows.Add ((ActiveCell.Row - ActiveCell.ListObject.Range.Row))
            'Change table name if needed - Insert one row below active cell
            .ListRows.Add ((ActiveCell.Row - ActiveCell.ListObject.Range.Row + 1))
        End If

    End With

End Sub

Answer 3

仅在ListObject内添加行，而不在整个工作表内添加行（请参见The VBA Guide To ListObject Excel Tables）

Option Explicit

Public Sub AddRowInListObject()
    Dim ActTable As ListObject
    On Error Resume Next 'next line throws error if ActiveCell is not in a table
        Set ActTable = ActiveCell.ListObject
    On Error GoTo 0 're-activate error reporting!

    If Not ActTable Is Nothing Then 'only add row if ActiveCell is within a table
        ActTable.ListRows.Add ActiveCell.Row - ActTable.Range.Row
    End If
End Sub

请注意，有2种不同的行计数系统：

ActiveCell.Row返回工作表的绝对行数
ListRows.Add，它等待相对于ListObject开头的行号

例如，如果ListObject从工作表的行5开始，则1的行号ListObject是工作表的行号5

在表中添加行而不影响条件格式

3 个答案: