返回列表 上一主題 發帖

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

本帖最後由 jsc0518 於 2021-6-17 21:39 編輯

回復 9# samwang
Hi samwang 您好!感謝您的熱心幫忙
試過了VBA,測試OK!
想與您請教,若分做兩個工作表,資料庫的部份工作表為"繳庫量",而需分析每一料號下出現幾個批號及總數加總則放在工作表為"Analysis"
那VBA要怎麼修訂呢?
感恩!!!

如下圖
001.jpg
2021-6-17 21:35



002.jpg
2021-6-17 21:35



Excel_VBA V2.rar (15.75 KB)
Just do it.

TOP

回復 8# hcm19522
Dear hcm19522 您好!感謝您的熱心解答
使用了公式,TEST OK。但我的資料筆數過多,需花一點時間。
謝謝你歐!
Just do it.

TOP

本帖最後由 samwang 於 2021-6-18 07:49 編輯

回復 11# jsc0518

請測試看看,謝謝。

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

TOP

本帖最後由 jsc0518 於 2021-6-18 10:16 編輯

回復 13# samwang
Dear samwang,
早安!您好!
感謝您的幫忙,我把語法COPY並執行,但發生了錯誤訊息:400(如下圖)
可以幫幫我嗎? ><"
拜託您了

Noname.jpg
2021-6-18 10:15



檔案如下
111.rar (25.89 KB)
Just do it.

TOP

回復 14# jsc0518

需要把程式放在模組裡面,謝謝

插入-->模組-->程式
擷取.PNG

TOP

回復 14# jsc0518

程式修改如下,要放在工作表或模組都可以,請再測試看看,謝謝。

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

TOP

回復 16# samwang

Dear samwang,
午安!您好!

可以用了,非常感謝您的幫忙!

再與您請教幾個問題
1.要怎麼知道那些語法(指令)是使用在模組?那些語法(指令)是使用在工作表的?
2.放在模組或工作表,他們的差異是在哪裡?

再麻煩您教導,謝謝您!
Just do it.

TOP

回復 17# jsc0518


無差別,只是寫法要注意,謝謝

例如:
工作表1模組: Range("A1")
一般模組:       Sheets("工作表1").Range("A1")

TOP

回復 18# samwang
知道了,謝謝您的教導。
Just do it.

TOP

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

TOP

        靜思自在 : 是非當教育,讚美作警惕。
返回列表 上一主題