✔ 最佳答案
巨集如下,在資料表中執行,但必須符合以下條件:
1.資料表從A欄開始,A1是ID,B1以後為每2欄為一組的:物品及數量(如題所示)
2.除題目所示之ID,物品及數量以外,沒有其他的資料.
3.結果會產生一個新工作表,命名為"統計".
Sub Macro1()
Range("A:B").Insert
Range("D1:E1").Copy Destination:=Range("A1:B1")
Range("B2") = "=COUNTA(C:C)"
NR = Range("B2")
Range("B2") = "=COUNTA(1:1)"
NC = Range("B2")
NE = ActiveSheet.Name
For N = 6 To NC Step 2
X = (NR - 1) * (N - 4) / 2 + 2
Range(Cells(2, N), Cells(2, N).Offset(NR - 1, 1)).Copy
Range("D" & X).PasteSpecial Paste:=xlPasteValues
Next N
Range("D:E").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1"), _
CopyToRange:=Range("A1"), Unique:=True
Range("B2") = "=COUNTA(A:A)"
M = Range("B2")
Range("B2") = "=SUMIF(D:D,A2,E:E)"
If M > 2 Then Range("B2").Copy Destination:=Range("B3:B" & M)
Range("B:B").Copy
Range("B:B").PasteSpecial Paste:=xlPasteValues
Sheets.Add.Name = "統計"
Sheets(NE).Range("A:B").Cut Destination:=Range("統計!A:B")
Sheets(NE).Range("A:B").Delete
Sheets(NE).Range(NR + 1 & ":5000").Delete Shift:=xlUp
Range("統計!A1").Select
End Sub