[發問] vba使用多條件加總 sumif

yifan2599

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

下載 (113.73 KB)

2021-8-6 23:05

test.zip (265.2 KB)

範例檔案
下載次數: 13

2021-8-6 23:09

singo1232001

test V1.zip (723.97 KB)

下載次數: 5

2021-8-7 04:35

回復 1# yifan2599


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


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

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

singo1232001

回復 2# singo1232001


    陣列版做好了
用了7維去切
大概5秒可以完成 不過不推薦這種方法 很容易錯 test v2.zip (511.09 KB)

下載次數: 3

2021-8-7 06:16

singo1232001

test v3.zip (485.13 KB)

下載次數: 6

2021-8-7 08:00

回復 1# yifan2599

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

准提部林

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

回復 5# 准提部林


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

yifan2599

回復 6# singo1232001


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

yifan2599

回復 5# 准提部林


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

下載 (56.66 KB)

2021-8-7 17:17

准提部林

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

回復 9# 准提部林



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