excel - 如何将数据拖到下一行？

Question

下午好，
我有一个表，其中 A 列有客户的数据，B 列有客户的姓名。在 C 到 L 列中包含该客户的发票信息。当 A 列和 B 列中有数据时，我想获得一个 vba 代码，在总计上方创建一行并将 1 行拖到发票信息下方，如下所示:
A2 和 B2 带有客户的代码和名称；
C3:L8 带有客户发票信息；
第九行:总行(我已经有了这个代码)

Sub table_customer()

Range("A1:L1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.349986266670736
    .PatternTintAndShade = 0
End With
Range("A1").Select
ActiveCell.FormulaR1C1 = "Code"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Customer"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Type Doc."
Range("D1").Select
ActiveCell.FormulaR1C1 = "Reference"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Data doc."
Range("F1").Select
ActiveCell.FormulaR1C1 = "Due date"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Currency"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Value eur"
Range("I1").Select
ActiveCell.FormulaR1C1 = "days delay"
Range("J1").Select
ActiveCell.FormulaR1C1 = "overdue v"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Obs."
Range("L2").Select
Selection.AutoFill Destination:=Range("L1:L2"), Type:=xlFillDefault
Range("L1:L2").Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "123"
Range("B2").Select
ActiveCell.FormulaR1C1 = "kkk"
Range("C2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("D2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("E2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("F2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("G2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("H2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("I2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("J2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("K2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("C3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("D3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("E3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("F3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("G3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("H3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("I3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("J3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("K3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("C4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("D4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("E4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("F4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("G4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("H4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("I4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("J4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("K4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("C5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("D5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("E5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("F5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("G5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("H5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("I5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("J5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("K5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("A6").Select
ActiveCell.FormulaR1C1 = "Total"
Range("A6:K6").Select
Range("K6").Activate
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.349986266670736
    .PatternTintAndShade = 0
End With
Rows("6:6").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C2:K5").Select
Selection.Cut Destination:=Range("C3:K6")
Range("C3:K6").Select
End Sub

根据打印品，目标是移动信息以获得线(当前为黄色)。那是最终目标。
目前，我有上面的信息 1 行，信息就在客户姓名的前面。如您所见，并非所有客户都有相同数量的发票。我的想法是 vba 代码应该读取具有“总计”的列 A 的单元格，然后在总行上方添加一行，最后将信息向下移动。

Answer 1

在您阅读本文之前，请记住我上一次主动编程是在 4 年前。表示代码乱七八糟，没有优化，等等等等
所以要求得到这样的列表:

变成这样的格式:

您可以使用以下代码片段。 “CommandButton1_Click()”函数之所以存在，是因为我将它用作来自用户窗体的触发器。可以从任何你喜欢的地方调用“adjustList”方法。
基本上我将所有客户数据 block 读入二维数组并清除单元格。在数组中收集所有条目并且所有单元格都清除后，我将数据再次以请求的格式写入单元格。
此外，根据要求，此功能可以处理条目，而与每个客户包含的行数无关，如我的屏幕截图所示。

Private Sub CommandButton1_Click()
    Call adjustList
End Sub

Function saveEntry(x As Integer, y As Integer) As Variant
    Dim tmpRows()
    Dim i As Integer
    Dim e As Integer
    Dim numOfRowsForEntry As Integer
    Dim numOfColumns As Integer
    numOfColumns = 10
    Dim tmpColumns() As String
    ReDim tmpColumns(numOfColumns)

    Cells(x, 1).Select
    numOfRowsForEntry = 0
    Do Until ActiveCell = "Total"
        Cells(x + numOfRowsForEntry, 1).Select
        numOfRowsForEntry = numOfRowsForEntry + 1
    Loop
    
    ReDim tmpRows(numOfRowsForEntry - 1)
    
    For i = 0 To UBound(tmpRows) - LBound(tmpRows)
        For e = 0 To numOfColumns
            tmpColumns(e) = ""
            tmpColumns(e) = Cells(x + i, y + e).Text
            Cells(x + i, y + e) = ""
            Cells(x + i, y + e).Interior.Color = xlNone
        Next
        
        tmpRows(i) = tmpColumns
    Next
    
    saveEntry = tmpRows
    Exit Function
End Function

Sub adjustList()
    Dim x As Integer
    Dim i As Integer
    Dim startRowOfList As Integer
    Dim entryList()
    
    Application.ScreenUpdating = False
    
    startRowOfList = 2
    NumRows = Cells(Rows.Count, 1).End(xlUp).Row
    
    ReDim Preserve entryList(0)
    Cells(startRowOfList, 3).Select
    
    i = 0
    For x = startRowOfList To NumRows
        Cells(x, 1).Select
        If Not IsEmpty(ActiveCell) And Not ActiveCell = "Total" Then
            entryList(i) = saveEntry(ActiveCell.Row, ActiveCell.Column)
            ReDim Preserve entryList(UBound(entryList) - LBound(entryList) + 1)
            i = i + 1
        End If
    Next
    
    Cells(startRowOfList, 1).Select
    For x = 0 To UBound(entryList) - LBound(entryList) - 1
        For i = 0 To UBound(entryList(x)) - LBound(entryList(x))
            If entryList(x)(i)(0) = "Total" Then
                ActiveCell.Offset(1, 0) = entryList(x)(i)(0)
                For e = 0 To 10
                    ActiveCell.Offset(1, e).Interior.ColorIndex = 15
                Next
            Else
                ActiveCell = entryList(x)(i)(0)
                ActiveCell.Offset(0, 1) = entryList(x)(i)(1)
            End If

            For c = 2 To UBound(entryList(x)(i)) - LBound(entryList(x)(i))
                ActiveCell.Offset(1, c) = entryList(x)(i)(c)
            Next
            
            ActiveCell.Offset(1, 0).Select
        Next
        
        ActiveCell.Offset(1, 0).Select
    Next
        
    Application.ScreenUpdating = True
End Sub