標題: [發問] 列出不同簽證號之第一筆號碼，並將相同簽證號之流水號金額加總 [打印本頁]

---

作者: aer    時間: 2023-1-6 11:48     標題: 列出不同簽證號之第一筆號碼，並將相同簽證號之流水號金額加總

請問如何列出不同簽證號之第一筆號碼，並將相同簽證號之流水號金額加總的公式？
例如：106-111-0000065簽證號之流水號有106-111-0000065001~009，其加總金額為273,031

[attach]35733[/attach]

[attach]35734[/attach]

---

作者: hcm19522    時間: 2023-1-6 14:29

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

---

作者: aer    時間: 2023-1-6 15:11

回復 2# hcm19522

公式測試正常，感謝您！

---

作者: Andy2483    時間: 2023-1-6 16:36

回復 1# aer


    謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,請前輩參考

執行結果:
[attach]35735[/attach]

Option Explicit
Sub TEST_20230106_1()
Dim Brr, i&, T1$, T2&, TT$, Y, M$, N&, P&
Set Y = CreateObject("Scripting.Dictionary")
Brr = [A1].CurrentRegion: N = 1
For i = 2 To UBound(Brr)
   T1 = Brr(i, 1): Brr(i, 1) = 0
   T2 = Brr(i, 2): Brr(i, 2) = 0
   TT = T1 & "|" & T2
   If Len(T1) = 15 And Not Y.Exists(T1) Then
      N = N + 1
      Y(T1) = N
      Brr(N, 1) = T1
      ElseIf Y(TT) = "" Then
         M = Left(T1, 15)
         Brr(Y(M), 2) = Brr(Y(M), 2) + T2
         P = P + T2
   End If
   Y(TT) = 1
Next
[E:F].ClearContents
With [E1].Resize(N, 2)
  .Value = Brr
  .Item(N + 1, 1) = "合計": .Item(N + 1, 2) = P
End With
Set Y = Nothing
Set Brr = Nothing
End Sub

---

作者: aer    時間: 2023-1-6 18:55

回復 4# Andy2483

測試正常，感謝前輩指導！

---

作者: samwang    時間: 2023-1-7 10:53

回復 1# aer

請測試看看，謝謝
Sub test()
Dim Arr, T$, T1, n&, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = [A1].CurrentRegion
For i = 2 To UBound(Arr)
    If Arr(i, 2) = "" Then GoTo 99
    T = Left(Arr(i, 1), 15)
    If xD.Exists(T) Then
        Arr(xD(T), 2) = Arr(xD(T), 2) + Arr(i, 2)
    Else
        n = n + 1: xD(T) = n
        Arr(n, 1) = T: Arr(n, 2) = Arr(i, 2)
    End If
    T1 = T1 + Arr(i, 2)
99: Next
[e1].CurrentRegion.Offset(1) = ""
[e2].Resize(n, 2) = Arr
Range("e" & n + 2) = "合計"
Range("f" & n + 2) = T1
End Sub

---

作者: aer    時間: 2023-1-7 18:48

回復 6# samwang

感謝前輩提供另一種方法，測試可用，謝謝您！

---

作者: Andy2483    時間: 2023-1-17 08:07

本帖最後由 Andy2483 於 2023-1-17 08:11 編輯

回復 7# aer


    謝謝 samwang前輩
今天學習 samwang前輩的方案做心得註解,請前輩參考

Option Explicit
Sub test()
Dim Arr, xD, T1, n&, i&, T$
'↑宣告變數:(n,i)是長整數變數,T是字串變數,其它是通用型變數
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是 字典
Arr = [A1].CurrentRegion
'↑令Arr是二維陣列!以 從[A1]儲存格串接八方相鄰儲存格擴展最小方正區域儲存格值倒入
For i = 2 To UBound(Arr)
'↑設順迴圈!i從2到Arr陣列縱向最大索引列號數
    If Arr(i, 2) = "" Then GoTo 99
    '↑如果i迴圈列2欄Arr陣列值是 空字元!就跳到99位置繼續執行
    T = Left(Arr(i, 1), 15)
    '↑令T這字串變數是 i迴圈列1欄Arr陣列值取左側15個字的新變數
    If xD.Exists(T) Then
    '↑如果T變數為key查xD字典是已經存在字典裡?
        Arr(xD(T), 2) = Arr(xD(T), 2) + Arr(i, 2)
        '↑令(T變數在xD字典的item值列2欄)Arr陣列值是 自身值+i迴圈列2欄Arr陣列值
    Else
    '↑以下是關於條件為否則的程序
        n = n + 1
        '↑令n這長整數變數是 自身累加 1的新整數  (指定結果列號)
        xD(T) = n
        '↑令T變數在xD字典的item值是 n變數  (記憶結果列號)
        Arr(n, 1) = T
        '↑令(n變數列1欄)Arr陣列值是 T字串變數  (結果寫入陣列)
        Arr(n, 2) = Arr(i, 2)
        '↑令(n變數列2欄)Arr陣列值是 i迴圈列2欄Arr陣列值  (把舊金額值變為結果的新值)
    End If
    T1 = T1 + Arr(i, 2)
    '↑令T1這通用型變數是 自身值 +  i迴圈列2欄Arr陣列值  (累加全部合計金額)
99: Next
[e1].CurrentRegion.Offset(1) = ""
'↑令[E1]儲存格串接八方相鄰儲存格擴展最小方正區域往下偏移1列儲存格值是空字元
[e2].Resize(n, 2) = Arr
'↑令[E2]儲存格擴展向下n變數列 往右擴展2欄的範圍儲存格以Arr陣列值倒入
'超過這範圍的Arr陣列值會被忽略
Range("e" & n + 2) = "合計"
'↑E欄n+2列儲存格值是 "合計"字串
Range("f" & n + 2) = T1
'↑F欄n+2列儲存格值是 T1變數  (全部合計)
End Sub

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)