v03586

回復 9# samwang


    感謝前輩的指導, 兩種方式都有學起來!! 以後有問題再請前輩多多指教!!

n7822123

回復 10# v03586

你會用字典物件的話，學Samwang的寫法就可以了

hcm19522大大，也證明了函數可以解決99.99% 的問題

我的寫法必須要先經過排列，不然會有問題~~

回頭看我寫的東西，寫的有點累贅~~~略簡化如下~

Sub 加總()
Dim Arr, PKey$, 刪除列 As Range
Arr = [A1].CurrentRegion    '抓儲存格資料 到 Arr 陣列
Set 刪除列 = Rows(UBound(Arr) + 1)  '這行單純只是避免Union跳出錯誤，先定個範圍
For R& = 2 To UBound(Arr)  '不同的Key紀錄頭一個列號，相同Key做累加，記錄之後要刪除的列號
  Key$ = Arr(R, 9) & Arr(R, 10)
  If Key <> PKey Then
    R0& = R: PKey = Key
    Arr(R, 13) = Arr(R, 12)
  Else
    Arr(R0, 13) = Arr(R0, 13) + Arr(R, 12)
     Set 刪除列 = Union(刪除列, Rows(R))
  End If
Next R
[A1].Resize(UBound(Arr), UBound(Arr, 2)) = Arr  'Arr資料倒回去儲存格
刪除列.Delete   '可改為 刪除列.Select 確認刪除範圍
End Sub

Andy2483

回復 1# v03586


    謝謝前輩發表此主題與範例,謝謝各位前輩,謝謝論壇
後學藉此帖練習陣列與字典,學習的解決方案如下,請前輩參考
請各位前輩指教

執行前:

下載 (118.43 KB)

2023-3-24 15:07

執行結果:

下載 (82.72 KB)

2023-3-24 15:08

Option Explicit
Sub TEST_2()
Dim Brr, Y, T$, C%, j%, i&, xA As Range
'↑宣告變數:(Brr,Y)是通用型變數,T是字串變數,
'(C,j)是短整數,i是長整數,xA是儲存格變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Set xA = Range([M1], Cells(Rows.Count, 1).End(3)): Brr = xA
'↑令xA這儲存格變數是 [M1]擴展到A欄最後有內容儲存格
'令Brr這通用型變數是 二維陣列,以xA變數(儲存格值)帶入
C = UBound(Brr, 2)
'↑令C這短整數變數是 Brr陣列橫向最大索引欄號
For i = 2 To UBound(Brr)
'↑設順迴圈!i從2到 Brr陣列縱向最大索引列號
   T = Brr(i, 9) & "|" & Brr(i, 10)
   '↑令T這字串變數是 i迴圈列第9欄Brr陣列值 連接 "|",
   '再連接 i迴圈列第10欄Brr陣列值,所組成的新字串
   If Y(T) = "" Then
   '↑如果T變數查Y字典的item值是空字元?
   '(這問句已經將 T變數當key,item是空字元,納入Y字典了,已增加個新key)
      Y(T) = Y.Count + 1
      '↑令 T變數當key,item是 Y字典key數量 + 1
      For j = 1 To C - 1: Brr(Y(T), j) = Brr(i, j): Next
      '↑設順迴圈!j從1到 C變數-1,陸續將該列各欄值帶入指定列同欄位置
      Brr(Y(T), 13) = Brr(Y(T), 12): GoTo i01
      '↑令(T變數查Y字典item值)列第13欄Brr陣列值是
      '(T變數查Y字典item值)列第12欄Brr陣列值
      '令程序跳到 i01標示位置繼續執行
   End If
   Brr(Y(T), 13) = Brr(Y(T), 13) + Brr(i, 12)
   '↑令(T變數查Y字典item值)列第13欄Brr陣列值是
   '自身值 + (T變數查Y字典item值)列第12欄Brr陣列值
i01: Next
ActiveSheet.UsedRange.Clear
'↑令有使用儲存格範圍做清除
xA.Resize(Y.Count + 1, C) = Brr
'↑令xA變數(儲存格)第1格擴展向下 Y字典key數量+1列,
'向右擴展C變數欄,這範圍儲存格值以Brr陣列值帶入
Set Y = Nothing: Set xA = Nothing: Erase Brr
'釋放變數
End Sub