[分享] 判斷出現不同批號幾次

jsc0518

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

下載 (62.81 KB)

2021-6-16 20:11

還請大大幫幫我
感恩


TEST.rar (8.98 KB)

下載次數: 11

2021-6-16 20:11

aer

回復 1# jsc0518
請參考
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)

samwang

回復 1# jsc0518

請測試看看，謝謝

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

jsc0518

回復 2# aer
Dear aer,
您好！非常感謝您的熱心指導，公式測試後發現一個問題
當我把來源資料刪除一欄列時，公式會有錯誤，這部分是否可以修改呢？
因我的資料每月都會產出(會新增)，所以欄位無法固定。
謝謝您！

下載 (326.03 KB)

2021-6-17 14:30

jsc0518

回復 3# samwang
Dear samwang,
您好！感謝您熱心的指導回覆
執行VBA後，在G2~G4蘭奇數據並未因批號多寡而自動計算變動
如下圖

下載 (345.61 KB)

2021-6-17 14:35

samwang

回復 5# jsc0518

請再試看看，謝謝

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

aer

TEST-動態陣列1.rar (12.53 KB)

下載次數: 6

2021-6-17 15:58

回復 4# jsc0518
改動態陣列試試

hcm19522

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

samwang

回復 5# jsc0518

不好意思，看了其他大大解答，終於了解您的需求了，6樓程式請忽略，下面程式請再測試看看，謝謝。

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

jsc0518

回復 7# aer

Hi 您好！感謝您的熱心幫忙，
剛剛RUN了一下語法，結果是我要的，但需要跑一些時間(連存檔案都要一點時間)，我的資料目前約有2381筆