下午好，
我有一個表，其中 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
According to the print, the objective is to move the information in order to obtain the line (which is currently in yellow). That's the ultimate goal. Currently, I have the information 1 line above, the information being right in front of the customer's names. As you can see, not all customers have the same number of invoices. My idea is that the vba code should read the cell of column A that has the "Total", then add a row above the total row, and finally shift the information down.
uj5u.com熱心網友回復：
在您閱讀本文之前，請記住我上一次主動編程是在 4 年前。意味著代碼很亂，沒有優化，等等等等
所以要求得到這樣的串列：
變成這樣的格式：
您可以使用以下代碼片段。“CommandButton1_Click()”函式之所以存在，是因為我將它用作來自用戶表單的觸發器。可以從任何你喜歡的地方呼叫“adjustList”方法。
Basically I read all the customer data blocks into two dimensional arrays and clear the cells. After all entries are collected in the array and all cells are clear i write the data into the cells again with the requested format.
Also as requested this function can handle entries independent of how many rows they contain per customer, as shown in my screenshots.
Private Sub CommandButton1_Click()
Call adjustList
End Sub
Function saveEntry(x As Integer, y As Integer) As Variant
Dim tmpColumns(10) As String
Dim tmpRows()
Dim i As Integer
Dim e As Integer
Dim numOfRowsForEntry As Integer
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 10
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 entryList(NumRows / 2) 'every customer has at least 2 lines
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
ActiveCell.Offset(1, 2) = entryList(x)(i)(2)
ActiveCell.Offset(1, 3) = entryList(x)(i)(3)
ActiveCell.Offset(1, 4) = entryList(x)(i)(4)
ActiveCell.Offset(1, 5) = entryList(x)(i)(5)
ActiveCell.Offset(1, 6) = entryList(x)(i)(6)
ActiveCell.Offset(1, 7) = entryList(x)(i)(7)
ActiveCell.Offset(1, 8) = entryList(x)(i)(8)
ActiveCell.Offset(1, 9) = entryList(x)(i)(9)
ActiveCell.Offset(1, 10) = entryList(x)(i)(10)
ActiveCell.Offset(1, 0).Select
Next
ActiveCell.Offset(1, 0).Select
Next
Application.ScreenUpdating = True
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/440543.html
上一篇：將單元格從一張紙復制到另一張紙
下一篇：陣列操作期間下標超出范圍