Question

我遇到了一些问题，我把一些VBA代码拉到了一起，我在其他地方找不到答案。我有一个名为TableOPQuery的表，它有40多列和超过10k行。

有一个名为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的行）中的所有内容，使两行相同。

我成功地编写了这个代码来帮助我插入用户想要的任何数量的行，但由于某种原因，我无法将其从用户编写值的原始行填充，我希望它能够清除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

Excel VBA：将行插入表格并填写

1 个答案:

假设