VBA Excel - 插入表格行,其格式与上面的行相同

时间:2016-05-27 21:56:41

标签: excel vba excel-vba

我有一个用户可以单击的按钮,它会在给定工作表上的给定表中添加一行。如果用户在表中选择了一个单元格,则宏确定它需要在所选内容的正下方添加一行。如果用户不在表中,那么它只是在表的底部添加一行。

它工作得很好,除了我无法弄清楚如何从上面的行复制格式。这可能吗?

我可能使用的代码如下:

Private tblTotalRows As Integer
Public selectedRow As Integer
Public selectedCol As Integer

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Add a row to the table
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub addRow(shtName As String, tblName As String, startRow As Integer)

    Dim tableRef As Integer

    Call getSelectedCell
    Call totalRowsInTable(shtName, tblName, startRow) ' Sets the selectedRow and tblTotalRows property

    ' We determine the row number where the new table row should be placed
    tableRef = selectedRow - startRow + 1

    ' Check to make sure the user is in the active table and then add a row
    If tableRef > 0 And selectedRow <= tblTotalRows Then
        Sheets(shtName).ListObjects(tblName).ListRows.Add (tableRef)
    Else
    ' If they're not in the table and then add a row to the bottom of the table
        Sheets(shtName).ListObjects(tblName).ListRows.Add AlwaysInsert:=True
    End If

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the row and column of the cell under selection
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub getSelectedCell()

    selectedRow = ActiveCell.Row
    selectedCol = ActiveCell.Column

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Count the number of rows in the Table
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub totalRowsInTable(shtName As String, tblName As String, startRow As Integer)

    Call getSelectedCell

    ' Select the entire table
    Sheets(shtName).ListObjects(tblName).Range.Select

    ' Count the number of rows in the table and add to the starting row
    tblTotalRows = Selection.Rows.Count + startRow - 1

    ' Go back to the users position
    Cells(selectedRow, selectedCol).Select

End Sub

2 个答案:

答案 0 :(得分:0)

作为备注,您可以从Sheets(shtName).ListObjects(tblName).Range.Row中的Sub返回 startRow ,并且不需要作为属性传递。

另外我想知道你需要复制什么格式,当你插入一行或多个单元格以复制上面单元格的格式时,Excel的默认行为。

在任何情况下,这些添加的行都会这样做(添加Dim s和最后几行):

Private Sub addRow(shtName As String, tblName As String, startRow As Integer)

    Dim tableRef As Integer
    Dim addedCells
    Dim addedCellRange As Range
    Dim previousCellRange As Range

    Call getSelectedCell
    Call totalRowsInTable(shtName, tblName, startRow) ' Sets the selectedRow and tblTotalRows property

    ' We determine the row number where the new table row should be placed
    tableRef = selectedRow - startRow + 1

    ' Check to make sure the user is in the active table and then add a row
    If tableRef > 0 And selectedRow <= tblTotalRows Then
        Set addedCells = Sheets(shtName).ListObjects(tblName).ListRows.Add(tableRef)
    Else
    ' If they're not in the table and then add a row to the bottom of the table
        Set addedCells = Sheets(shtName).ListObjects(tblName).ListRows.Add 'AlwaysInsert:=True
    End If
    ' Copy formats here
    Set addedCellRange = addedCells.Range
    Set previousCellRange = Range(Cells(addedCellRange.Row - 1, addedCellRange.Column), Cells(addedCellRange.Row - 1, addedCellRange.Column + addedCellRange.Columns.Count - 1))
    previousCellRange.Copy
    addedCellRange.PasteSpecial xlPasteFormats
    Application.CutCopyMode = 0

End Sub

答案 1 :(得分:0)

可以缩短为

Private Sub addRow(shtName As String, tblName As String)
    Dim newRow as Range

    With Sheets(shtName).ListObjects(tblName)
       If Not Intersect(ActiveCell,.Range) Is Nothing Then
            Set newRow= .ListRows.Add(ActiveCell.Row - .Range.Rows(1).Row + 1).Range
       Else
            Set newRow= .ListRows.Add(AlwaysInsert:=True).Range
       End If
    End With 

    With newRow
        .offset (-1).Copy
        .PasteSpecial xlPasteFormats
    End With 
    Application.CutCopyMode = False
End Sub