1.資料中有料號，所以我可以利用公式抓出來她的總數量
2.但是，每一料號下都會產出許多批號(因為是不同天產出)
3.我想要把資料變成下圖內容，右邊的欄位樣子
[attach]33400[/attach]

[attach]33401[/attach]

G3=SUMPRODUCT((1/COUNTIF(\$B\$2:\$B\$10,\$B\$2:\$B\$10)*(\$A\$2:\$A\$10=F2)))

H3=SUMIF(\$A\$2:\$A\$10,F2,\$C\$2:\$C\$10)

Sub test()
Dim Arr, xD, xD1, T1, TT, i&
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
Arr = Range([c1], [a65536].End(3))
For i = 2 To UBound(Arr)
T1 = Arr(i, 1): TT = Arr(i, 1) & Arr(i, 2)
If xD.Exists(TT) Then
xD(TT & "") = xD(TT & "") + 1
xD(T1 & "") = xD(TT & "")
Else
xD(TT & "") = 1: xD(T1 & "") = 1
End If
xD1(T1 & "") = xD1(T1 & "") + Arr(i, 3)
Next
Arr = Range([g2], [f65536].End(3))
For i = 1 To UBound(Arr)
Arr(i, 1) = xD(Arr(i, 1) & "")
Arr(i, 2) = xD1(Arr(i, 1) & "")
Next
Range("g2").Resize(UBound(Arr)) = Arr
End Sub

Dear aer,

[attach]33402[/attach]

Dear samwang,

[attach]33403[/attach]

Sub test2()
Dim Arr, xD, xD1, T1, i&
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
Arr = Range([c1], [a65536].End(3))
For i = 2 To UBound(Arr)
T1 = Arr(i, 1)
xD(T1 & "") = xD(T1 & "") + 1
xD1(T1 & "") = xD1(T1 & "") + Arr(i, 3)
Next
Arr = Range([g2], [f65536].End(3))
For i = 1 To UBound(Arr)
T1 = Arr(i, 1)
Arr(i, 1) = xD(T1 & "")
Arr(i, 2) = xD1(T1 & "")
Next
Range("g2").Resize(UBound(Arr), 2) = Arr
End Sub

[attach]33406[/attach]回復 4# jsc0518

[attach]33406[/attach]

https://blog.xuite.net/hcm19522/twblog/589839401

Sub test3()
Dim Arr, xD, xD1, T1, TT, i&
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
Arr = Range([c1], [a65536].End(3))
For i = 2 To UBound(Arr)
T1 = Arr(i, 1): TT = Arr(i, 1) & Arr(i, 2)
If Not xD.Exists(TT) Then
xD(TT & "") = xD(TT & "") + 1
xD(T1 & "") = xD(T1 & "") + xD(TT & "")
End If
xD1(T1 & "") = xD1(T1 & "") + Arr(i, 3)
Next
Arr = Range([g2], [f65536].End(3))
For i = 1 To UBound(Arr)
T1 = Arr(i, 1)
Arr(i, 1) = xD(T1 & "")
Arr(i, 2) = xD1(T1 & "")
Next
Range("g2").Resize(UBound(Arr), 2) = Arr
End Sub

Hi 您好！感謝您的熱心幫忙，

Hi samwang 您好！感謝您的熱心幫忙

[attach]33407[/attach]

[attach]33408[/attach]

[attach]33409[/attach]

Dear hcm19522 您好！感謝您的熱心解答

Sub test4()
Dim Arr, xD, xD1, T1, TT, i&
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
Arr = Range([繳庫量!e1], [繳庫量!y65536].End(3))
For i = 2 To UBound(Arr)
T1 = Arr(i, 1): TT = Arr(i, 1) & Arr(i, 2)
If Not xD.Exists(TT) Then
xD(TT & "") = xD(TT & "") + 1
xD(T1 & "") = xD(T1 & "") + xD(TT & "")
End If
xD1(T1 & "") = xD1(T1 & "") + Arr(i, 21)
Next
With Sheets("Analysis")
Arr = .Range(.[b2], .[a65536].End(3))

For i = 1 To UBound(Arr)
T1 = Arr(i, 1)
Arr(i, 1) = xD(T1 & "")
Arr(i, 2) = xD1(T1 & "")
Next
.Range("b2").Resize(UBound(Arr), 2) = Arr
End With

End Sub

Dear samwang,

[attach]33417[/attach]

[attach]33419[/attach]

Sub test5()
Dim Arr, xD, xD1, T1, TT, i&
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
With Sheets("繳庫量")
Arr = .Range(.[e1], .[y65536].End(3))
For i = 2 To UBound(Arr)
T1 = Arr(i, 1): TT = Arr(i, 1) & Arr(i, 2)
If Not xD.Exists(TT) Then
xD(TT & "") = xD(TT & "") + 1
xD(T1 & "") = xD(T1 & "") + xD(TT & "")
End If
xD1(T1 & "") = xD1(T1 & "") + Arr(i, 21)
Next
End With
With Sheets("Analysis")
Arr = .Range(.[b2], .[a65536].End(3))
For i = 1 To UBound(Arr)
T1 = Arr(i, 1)
Arr(i, 1) = xD(T1 & "")
Arr(i, 2) = xD1(T1 & "")
Next
.Range("b2").Resize(UBound(Arr), 2) = Arr
End With
End Sub

Dear samwang,

1.要怎麼知道那些語法(指令)是使用在模組？那些語法(指令)是使用在工作表的？
2.放在模組或工作表，他們的差異是在哪裡？

Sub TEST_A1()
Dim Arr, xD, T\$, TT\$, i&, j%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([繳庫量!e1], [繳庫量!y65536].End(3))
For i = 2 To UBound(Arr)
T = Arr(i, 1): TT = T & "|" & Arr(i, 2)
xD(TT) = xD(TT) + 1
If xD(TT) = 1 Then xD(T & "/1") = xD(T & "/1") + 1
xD(T & "/2") = xD(T & "/2") + Arr(i, 21)
Next
Arr = Range([Analysis!b1], [Analysis!a65536].End(3))
For i = 2 To UBound(Arr)
For j = 1 To 2: Arr(i - 1, j) = xD(Arr(i, 1) & "/" & j): Next
Next
[Analysis!b2].Resize(UBound(Arr) - 1, 2) = Arr
End Sub

Dear 准提部林,

VBA語法使用過，TEST OK。非常感謝您的熱心幫忙！
^_^

Dear 准提部林,

Sub Analysis()

Dim Arr, xD, T\$, TT\$, i&, j%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([繳庫量!g1], [繳庫量!u65536].End(3)) 'g=代號、u=總公斤數
For i = 2 To UBound(Arr)
T = Arr(i, 1): TT = T & "|" & Arr(i, 2)
xD(TT) = xD(TT) + 1
If xD(TT) = 1 Then xD(T & "/1") = xD(T & "/1") + 1
xD(T & "/2") = xD(T & "/2") + Arr(i, 15) '15=g~u
Next
Arr = Range([Analysis!b1], [Analysis!a65536].End(3))
For i = 2 To UBound(Arr)
For j = 1 To 2: Arr(i - 1, j) = xD(Arr(i, 1) & "/" & j): Next
Next
[Analysis!b2].Resize(UBound(Arr) - 1, 2) = Arr

End Sub

Dear 准提部林,

 歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)