返回列表 上一主題 發帖

[發問] 刪除重複後,尋找重複客戶號碼加總值

回復 9# 准提部林


    謝謝論壇,謝謝前輩
後學藉此帖學習前輩的方案,學習心得註解如下,請前輩再指導

執行前:


執行結果:


Option Explicit
Sub TEST()
Dim Arr, Brr, xD, T&, i&, j%, U&, N&
'↑宣告變數
Arr = Range([A1], [A65536].End(xlUp)(1, 7))
'↑令Arr變數是二維陣列,令以[A1]到 (A欄最後有內容儲存格的右方7格),
'以這範圍儲存格值帶入
'同Arr = Range([G1], [A65536].End(xlUp))

Set xD = CreateObject("scripting.dictionary")
'↑令xD變數是字典
ReDim Brr(1 To UBound(Arr), 1 To 7)
'↑宣告Brr變數是同Arr陣列大小的空陣列
For i = 2 To UBound(Arr)
'↑設順迴圈
    T = Arr(i, 1): U = xD(T)
    '↑令T變數是 客戶編號: '↑令U變數是 以T變數查xD字典的item值
    If U > 0 Then Brr(U, 5) = Brr(U, 5) + Arr(i, 5): GoTo 101
    '↑如果U變數已經紀錄了結果陣列Brr的索引列號?
    '就令在結果陣列Brr正確位置累加 Arr陣列的金額
    '令程序跳到 101標註位置繼續執行

    N = N + 1: U = N: xD(T) = N
    '↑令N變數累加1 :令U變數裝N變數值 :令以T變數當key,item是 N變數
    For j = 1 To 7: Brr(U, j) = Arr(i, j): Next
    '↑設順迴圈將初次符合條件的資料帶入 結果陣列Brr
    'N變數是用來累計索引列號的,U是用來盛裝重複 客戶編號在結果陣列的索引列號

101: Next i
If N > 0 Then [J1].Resize(N, 7) = Brr
'↑如果結果陣列有資料!就從[J1]開始貼入局部的Brr陣列值
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

本帖最後由 Andy2483 於 2023-5-9 08:20 編輯

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教

Option Explicit
Sub TEST_1()
Dim Brr,  Y, i&, j%
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是字典
Brr = Range([G1], [A65536].End(xlUp))
'↑令變數是二維陣列並以儲存格值倒入
For i = 2 To UBound(Brr)
'↑設順迴圈
   If Y(Brr(i, 1)) = "" Then
   '↑這疑問句已經不知不覺將 key是Brr(i, 1),item是"" ,納入在Y字典中了
      Y(Brr(i, 1)) = Y.Count
      '↑索性就依當下key的數量當變數紀錄此key在陣列中的索引列號
      For j = 1 To 7: Brr(Y.Count, j) = Brr(i, j): Next: GoTo i01
      '↑因為是首次納入此key,所以將各欄位值帶入指定位置,覆蓋舊陣列值,
      '↑以上就已經處理了首次值,不必累加金額,所以跳到i01指定位置繼續執行

   End If
   Brr(Y(Brr(i, 1)), 5) = Brr(Y(Brr(i, 1)), 5) + Brr(i, 5)
   '↑如果程序能跑到這裡,代表不是首次,將該key所帶的item調出來(索引列號),
   '讓金額做累加

i01: Next
[J:P].ClearContents
'↑清除結果儲存格舊資料
If Y.Count > 0 Then [J1].Resize(Y.Count, 7) = Brr
'↑如果字典裡有keys!就從[J1]開始貼入Brr陣列局部值
Set Y = Nothing: Erase Brr
'↑釋放變數
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 願要大、志要堅、氣要柔、心要細。
返回列表 上一主題