jsc0518

回復 20# 准提部林

Dear 准提部林,
早安您好！
VBA語法使用過，TEST OK。非常感謝您的熱心幫忙！
^_^

samwang

准大只用了一個字典就解決了，而且效率也很快，感謝准大分享，謝謝。

jsc0518

回復 20# 准提部林

Dear 准提部林,
晚上好！與您請教一下，
我的資料庫欄位有異動過 --> g=代號、u=總公斤數
我將您的VBA語法更改過下面的資料(紅字)
可是我改過後，卻無法帶出我想要的狀況，是否哪裡還須修改呢？


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

准提部林

回復 23# jsc0518


看來沒錯,
是哪裡的問題???

程式發生錯誤? 還是結果?

jsc0518

回復 24# 准提部林
Dear 准提部林,
抱歉，試出來了，我弄錯欄位了。感恩囉！

Andy2483

回復 20# 准提部林


    謝謝前輩!
以下心得註解!請前輩再指導!謝謝
Option Explicit
Sub TEST_A1()
Dim Arr, xD, T$, TT$, i&, j%
'↑宣告變數
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典
Arr = Range([繳庫量!e1], [繳庫量!y65536].End(3))
'↑令Arr是字典!倒入 繳庫量表[E1] 與Y欄最後-有內容儲存格之間
',最小方正區域儲存格的值
For i = 2 To UBound(Arr)
'↑設順迴圈!,i從2 到Arr陣列最後一縱向列數
     T = Arr(i, 1)
     '↑令是Arr陣列迴圈列數 第1縱向欄值(表裡的代號欄值)
     TT = T & "|" & Arr(i, 2)
     '↑令TT是 代號 & "|" & 批號  的組合字串
     xD(TT) = xD(TT) + 1
     '↑組合字串當key!Item累加1
     If xD(TT) = 1 Then
     '↑如果組合字串的item 是 1時(TT組合字串剛到入字典時)
        xD(T & "/1") = xD(T & "/1") + 1
        '↑令 代號 & "/1" 的組合字串當key!Item累加1
        '這裡的 "/1" 是為了指向結果資料的欄位數1  '@@
        '也就是有不同組合時 同代號出現不同批號次數+1
     End If
     xD(T & "/2") = xD(T & "/2") + Arr(i, 21)
     '↑令 代號 & "/2" 的組合字串當key!Item累加總公斤數
     '這裡的 "/2" 是為了指向結果資料的欄位數2   '@@
Next
Arr = Range([Analysis!b1], [Analysis!a65536].End(3))
'↑重新令Arr是字典!倒入 Analysis表[B1] 與A欄最後-有內容儲存格之間
',最小方正區域儲存格的值
For i = 2 To UBound(Arr)
'↑設外順迴圈!,i從2 到Arr陣列最後一縱向列數
    For j = 1 To 2
    '↑設內順迴圈!,j從1 到2
       Arr(i - 1, j) = xD(Arr(i, 1) & "/" & j)
      '↑用Analysis表的關鍵字搭配"/"符號與內順迴圈數當Key!
       '查字典裡的item值 如上標註 @@處
       '將結果item值放在關鍵字列前一列迴圈對應欄裡!
       '因為後方 ##標示處有 -1,所以不會導致Arr最後列貼入結果!
    Next
Next
[Analysis!b2].Resize(UBound(Arr) - 1, 2) = Arr    '##
'將Arr陣列從Analysis表[B2]開始貼入!
'因為Resize()= Arr的方式是直接最左上角範圍的的元素!
'所以前輩才從Arr第一列開始帶入結果
'如果是後學為了保險起見!會加個Brr來裝結果!
'謝謝指導!
End Sub