麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] vba使用多條件加總 [打印本頁]

作者: yifan2599 時間: 2021-8-6 23:10 標題: vba使用多條件加總

因為資料太多了，使用sumifs套入公式需跑5分鐘以上，不知道是否有比較快速的方式?
聽說陣列好像會快很多~
陣列部分因為不熟悉如何使用，不知是否可以幫忙解惑... (條件如反藍色部分)

[attach]33845[/attach]

[attach]33846[/attach]

作者: singo1232001 時間: 2021-8-7 04:36

本帖最後由 singo1232001 於 2021-8-7 04:45 編輯

[attach]33847[/attach]回復 1# yifan2599

主要用字典創的
我的電腦要跑18秒左右

也用多維陣列去試
結果記憶體容量炸了創不出來 1億多格

不過用點奇淫技巧也是可以

作者: singo1232001 時間: 2021-8-7 06:17

回復 2# singo1232001

陣列版做好了
用了7維去切
大概5秒可以完成不過不推薦這種方法很容易錯[attach]33848[/attach]

作者: singo1232001 時間: 2021-8-7 08:01

[attach]33849[/attach]回復 1# yifan2599

也補上一般陣列的寫法
我的電腦大概40秒

作者: 准提部林 時間: 2021-8-7 09:26

Sub TEST_A1()
Dim Arr, Brr, xD, R&, C%, i&, j%, k%, T$, TT$, TM
TM = Timer
R = [差異!a1].Cells(Rows.Count, 1).End(xlUp).Row - 3
C = [差異!a4].Cells(1, Columns.Count).End(xlToLeft).Column
If R < 2 Or C < 9 Then Exit Sub
'---------------------------------------
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Data!h1], [Data!a1].Cells(Rows.Count, 1).End(xlUp))
For i = 2 To UBound(Arr)
For j = 1 To 6
      T = T & "|" & Arr(i, Mid(234517, j, 1))
Next j
xD(T) = xD(T) + Val(Arr(i, 8)): T = ""
Next i
'-------------------------------------
Arr = [差異!a4].Resize(R, C)
ReDim Brr(1 To R - 1, 1 To C - 8)
For i = 2 To R
T = ""
For j = 1 To 5: T = T & "|" & Arr(i, j): Next j
For k = 1 To UBound(Brr, 2)
      TT = T & "|" & Arr(1, k + 8)
      If xD.Exists(TT) Then Brr(i - 1, k) = xD(TT)
Next k
Next i
'-------------------------------------
[差異!i5].Resize(R - 1, C - 8) = Brr
Arr = "": Brr = "": Set xD = Nothing
MsgBox Timer - TM
End Sub

''大約1秒

作者: singo1232001 時間: 2021-8-7 12:18

回復 5# 准提部林

這招真的香!
mid的用法更是畫龍點睛!

作者: yifan2599 時間: 2021-8-7 17:08

回復 6# singo1232001

真的蠻妙的.... 研究超久..
雖然還是不太懂.. XD

作者: yifan2599 時間: 2021-8-7 17:17

回復 5# 准提部林

感謝解惑，速度爆快~
不過[差異]欄位部分沒有計算出來..
不知道該加入哪段語法呢?

[attach]33851[/attach]

作者: 准提部林 時間: 2021-8-7 19:41

Sub TEST_A1()
Dim Arr, Brr, xD, R&, C%, i&, j%, k%, T$, TT$, TS$(2), TC$, TM
TM = Timer
R = [差異!a1].Cells(Rows.Count, 1).End(xlUp).Row - 3
C = [差異!a4].Cells(1, Columns.Count).End(xlToLeft).Column
If R < 2 Or C < 9 Then Exit Sub
'---------------------------------------
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Data!h1], [Data!a1].Cells(Rows.Count, 1).End(xlUp))
For i = 2 To UBound(Arr)
For j = 1 To 6
      T = T & "|" & Arr(i, Mid(234517, j, 1))
Next j
xD(T) = xD(T) + Val(Arr(i, 8)): T = ""
Next i
'-------------------------------------
Arr = [差異!a4].Resize(R, C)
ReDim Brr(1 To R - 1, 1 To C - 8)
For i = 2 To R
T = ""
For j = 1 To 4: T = T & "|" & Arr(i, j): Next j
For k = 1 To UBound(Brr, 2)
      TT = T & "|" & Arr(i, 5) & "|" & Arr(1, k + 8)
      TC = T & "|差異" & "|" & Arr(1, k + 8)
      If xD.Exists(TT) Then
         Brr(i - 1, k) = xD(TT):  xD(TC) = ""
         For j = 1 To 2: TS(j) = T & "|版本" & j & "|" & Arr(1, k + 8): Next j
      End If
      If Arr(i, 5) = "差異" Then
         If xD.Exists(TC) Then Brr(i - 1, k) = xD(TS(2)) - xD(TS(1))
      End If
Next k
Next i
'-------------------------------------
[差異!i5].Resize(R - 1, C - 8) = Brr
Arr = "": Brr = "": Set xD = Nothing
MsgBox Timer - TM
End Sub

'差異 = 版本2 - 版本1 ???

===========================

作者: yifan2599 時間: 2021-8-7 22:31

回復 9# 准提部林

是的，版本2-版本1。
不過名稱可能會變，可能會是版本的日期

作者: 准提部林 時間: 2021-8-7 22:46

回復 10# yifan2599

那同时有幾個版本??
還是固定版本? + 版本? 差異, 每三行一組??

作者: 准提部林 時間: 2021-8-7 22:50

回復 10# yifan2599

Sub TEST_A1()
Dim Arr, Brr, xD, R&, C%, i&, j%, k%, T$, TT$, TC$, TM
TM = Timer
R = [差異!a1].Cells(Rows.Count, 1).End(xlUp).Row - 3
C = [差異!a4].Cells(1, Columns.Count).End(xlToLeft).Column
If R < 2 Or C < 9 Then Exit Sub
'---------------------------------------
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Data!h1], [Data!a1].Cells(Rows.Count, 1).End(xlUp))
For i = 2 To UBound(Arr)
For j = 1 To 6
      T = T & "|" & Arr(i, Mid(234517, j, 1))
Next j
xD(T) = xD(T) + Val(Arr(i, 8)): T = ""
Next i
'-------------------------------------
Arr = [差異!a4].Resize(R, C)
ReDim Brr(1 To R - 1, 1 To C - 8)
For i = 2 To R
T = ""
For j = 1 To 4: T = T & "|" & Arr(i, j): Next j
For k = 1 To UBound(Brr, 2)
      TT = T & "|" & Arr(i, 5) & "|" & Arr(1, k + 8)
      TC = T & "|差異" & "|" & Arr(1, k + 8)
      If xD.Exists(TT) Then Brr(i - 1, k) = xD(TT): xD(TC) = ""
      If i > 3 And Arr(i, 5) = "差異" Then
         If xD.Exists(TC) Then Brr(i - 1, k) = Brr(i - 2, k) - Brr(i - 3, k)
      End If
Next k
Next i
'-------------------------------------
[差異!i5].Resize(R - 1, C - 8) = Brr
Arr = "": Brr = "": Set xD = Nothing
MsgBox Timer - TM
End Sub

再不行, 給了二個方法, 自己去調整!!!

作者: yifan2599 時間: 2021-8-8 01:14

回復 12# 准提部林

非常感謝，正在努力調整中... ^^

作者: Andy2483 時間: 2023-3-14 10:29

本帖最後由 Andy2483 於 2023-3-14 10:37 編輯

回復 12# 准提部林

謝謝前輩
後學研讀此帖學習到很多知識,心得註解如下,請前輩再指導

Option Explicit
Sub TEST_A1()
Dim Arr, Brr, xD, TM, R&, i&, C%, j%, k%, T$, TT$, TC$
'↑宣告變數:(Arr,Brr,xD,TM)是通用型變數,(R,i)是長整數變數,
'(C,j,k)是短整數變數,(T,TT,TC)是字串變數
TM = Timer
'↑令TM這通用型變數是當下時間
R = [差異!a1].Cells(Rows.Count, 1).End(xlUp).Row - 3
'↑令R這長整數變數是差異表A欄最後一個有內容儲存格列號 -3
C = [差異!a4].Cells(1, Columns.Count).End(xlToLeft).Column
'↑令C這短整數變數是差異表第4列最右一個有內容儲存格欄號
If R < 2 Or C < 9 Then Exit Sub
'↑如果R變數<2 或C<9!就結束程式執行
'---------------------------------------
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD這通用型變數是字典
Arr = Range([Data!h1], [Data!a1].Cells(Rows.Count, 1).End(xlUp))
'↑令Arr這通用型變數是二維陣列,以Data1表[H1]到A欄最後有內容儲存格,
'此範圍存格值帶入Arr陣列中
For i = 2 To UBound(Arr)
'↑設順迴圈!i從2到Arr陣列縱向最大索引號
For j = 1 To 6
'↑設順迴圈!j從1到 6
      T = T & "|" & Arr(i, Mid(234517, j, 1))
      '↑令T這字串變數是自身連接"|"再連接i迴圈列Mid()欄Arr陣列值
      'Mid():234517值的第(j變數)字開始,取1字
Next j
xD(T) = xD(T) + Val(Arr(i, 8)): T = ""
'↑令T變數在xD字典裡的Item值是 Item值自身再 + Val()值,
'Val()值:i迴圈列第8欄Arr陣列值經轉化為數值
'令T變數是空字元
Next i
'-------------------------------------
Arr = [差異!a4].Resize(R, C)
'↑令Arr這通用型變數換裝入差異表[A4]擴展向下R變數列,向右C變數欄
ReDim Brr(1 To R - 1, 1 To C - 8)
'↑宣告Brr這通用型變數是二維陣列,範圍大小:縱向索引號從1到 R變數-1,
'橫向索引號從1到 C變數-8
For i = 2 To R
'↑設順迴圈!i從2到 R變數
T = ""
'↑令T變數是空字元
For j = 1 To 4: T = T & "|" & Arr(i, j): Next j
'↑設順迴圈!j從1到 4:令T變數是自身連接"|"再連接i迴圈列j迴圈欄Arr陣列值
For k = 1 To UBound(Brr, 2)
'↑設順迴圈!k從1到 Brr陣列橫向最大索引欄號
      TT = T & "|" & Arr(i, 5) & "|" & Arr(1, k + 8)
      '↑令TT這字串變數是T變數連接"|",續接i迴圈列第5欄Arr陣列值,再連接"|",
      '最後連接1列第k變數+8欄的Arr陣列值的新字串
      TC = T & "|差異" & "|" & Arr(1, k + 8)
      '↑令TC這字串變數是 T變數連接"|差異"字串,再連接"|",
      '最後連接1列第k變數+8欄的Arr陣列值的新字串
      If xD.Exists(TT) Then Brr(i - 1, k) = xD(TT): xD(TC) = ""
      '↑如果以TT變數查xD字典是存在此key,
      '就令(i迴圈數-1)列,K迴圈欄Brr陣列值是以TT變數查xD字典的回傳Item值
      '令TC變數當Key,Item是空字元納入xD字典裡
      If i > 3 And Arr(i, 5) = "差異" Then
      '↑如果i迴圈數大於3 而且i迴圈列第5欄Arr陣列值是 "差異"字串
         If xD.Exists(TC) Then Brr(i - 1, k) = Brr(i - 2, k) - Brr(i - 3, k)
         '↑如果以TC變數查xD字典是存在此key,
         '就令(i迴圈數-1)列K迴圈欄Brr陣列值是
         '(i迴圈數-2)列K迴圈欄Brr陣列值  -  (i迴圈數-3)列K迴圈欄Brr陣列值
      End If
Next k
Next i
'-------------------------------------
[差異!i5].Resize(R - 1, C - 8) = Brr
'↑令差異表[I5]儲存格擴展向下R變數-1列,向右擴展C變數-8欄,
'此範圍儲存格值以Brr陣列值帶入
Arr = "": Brr = "": Set xD = Nothing
'釋放變數
MsgBox Timer - TM
'↑令跳出提示窗!顯示當下時間-TM變數
End Sub

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