Excel VBA：將行插入表中並填寫上方行中的所有內容

Question

我整理了一些VBA代碼時遇到問題，但在其他地方找不到答案。 我有一個名為TableOPQuery的表，該表具有40多個列和1萬多行。

有一個稱為SPLITS的列，用戶將在其中寫入值x（整數）。 如果該值大於1，則將在用戶寫入該值的行下插入一行，因為該值的目的是添加行並復制原始行具有的所有內容（值，公式，格式）以使用戶指定的行數（包括原始行）相同，因此將類似於“ x-1”。

這是一個示例，因為我可能無法很好地解釋它：

Order   Provider       Amount   Type    Splits  Shipped
23     Shady company    10000   Whole   1   
30     That company     2000    Split   2   
*30     That company     2000   Split*
35     This company     420     Whole       

因此，您看到用戶在第1行（第23行）中寫了1，因此不會插入任何行。 但是，在第2行（第30行）中，用戶寫了2。因此，將插入另一行，復制上一行（用戶插入2的那一行）中的所有內容，以使2行彼此相同。

我設法拼湊了這段代碼，該代碼可以幫助我插入用戶想要的任意數量的行，但是由於某些原因，我無法使其從用戶編寫該值的原始行填充下來，而我希望它清除其中的內容SPLIT行不會再次觸發代碼。

我現在很困惑，因為正常的填充功能無法正常工作。 我可以插入行， 但是我不能復制並填寫上面行中的所有內容 ，也無法清除列SPLITS。

Private Sub Worksheet_Change(ByVal Target As range)
    Dim KeyCells As range
    Dim xValue As Integer
    Dim tbl As ListObject
    Dim tRows As Long
    Dim tCols As Long
    Dim originCell As String

    'I call a fuction that will give me the position of the column that has SPLITS in it, searching a predefined row (5:5). I know this is unnecessary but this is the best I could do because the column SPLITS might change of position (add/delete columns)
    col = ColumnNumberByHeader("Splits")

   'I use this to get the amount of rows the table has mostly
    Set tbl = ActiveSheet.ListObjects("TableOPQuery")
    With tbl.DataBodyRange
        tRows = .Rows.Count
        tCols = .Columns.Count
    End With

   'An If to get a range using the a predefined start row (5), the col I got earlier, and the amount of rows the table has. If I get 0 as col is because the column does not exist
    If col <> 0 Then
        Set KeyCells = range(Cells(5, col), Cells(tRows, col))
    Else
        Cancel = True
        MsgBox "Check that column SPLITS exist"
        Exit Sub
    End If

    'Here is where the level noob magic happens. Rows start getting inserted if a value in the range I got in KeyCells happens
    If Not Application.Intersect(KeyCells, range(Target.Address)) Is Nothing Then
        'If the value is not numeric then nothing will run
        If IsNumeric(Target) Then
            'If the target is greater than 1 then the amount of Target.Value minus 1 of rows will be inserted under the row where the change occurred
            If Target.Value > 1 Then 
                originCell = Target.Address       
                xValue = Target.Value - 1
                MsgBox "Cell " & Target.Address & " has changed."
                'A loop to insert the rows, I use - 4 because the Target.Address is of the whole worksheet, and not the table itself.
                For i = 1 To Target.Value - 1 Step 1
                    tbl.ListRows.Add (range(Target.Address).row - 4)
                    'Filling down into the inserted rows from the row of the originCell (where the user inserted the value)
                    range(originCell).EntireRow.FillDown
                Next i
            End If
        End If
    End If
End Sub

Answer 1

假設條件

• 工作表名稱（包含表）： Sheet1
• 表名稱： TableOPQuery
• 對應的列標題： Splits

嘗試這個：

Private Sub Worksheet_Change(ByVal Target As Range)

    If ActiveSheet.Name = "Sheet1" Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False

        Dim tbl As ListObject
        Dim rng As Range
        Dim SCI As Integer 'Specific Column Index
        Dim CN As String 'Column Name

        CN = "Splits"
        Set tbl = Worksheets("Sheet1").ListObjects("TableOPQuery")
        Set rng = Range("TableOPQuery[#All]")
        SCI = Application.WorksheetFunction.Match(CN, Range("TableOPQuery[#Headers]"), 0)

        If Cells(rng.Row + rng.Rows.Count - 1, rng.Column + SCI - 1) > 1 Then
            tbl.ListRows.Add
            Range(Cells(rng.Row + rng.Rows.Count, rng.Column).Address & ":" & _
                Cells(rng.Row + rng.Rows.Count, rng.Column + rng.Columns.Count - 1).Address).FillDown
        End If

    End If

    Application.EnableEvents = True
End Sub