12345
返回列表 上一主題 發帖

請問sumif 改寫成字典或是array讓執行速度變快

s3526369
　暱稱: 大榮

中學生Rank: 2

帖子
45 
主題
3 
精華
0 
積分
72 
點名
0  
作業系統
WIN7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2018-2-12 
最後登錄
2024-7-15 
31# 跳轉到 »
發表於 2022-9-16 17:29 | 只看該作者
回復 30# s3526369
要看模組 Module2

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2024-10-30 
32#
發表於 2022-9-16 19:09 | 只看該作者
回復  Andy2483

前輩~你看看這個,我套用samwang前輩方式去整理出來!
執行速度很快,但是目前遇到的問題 ...
s3526369 發表於 2022-9-16 16:45



附件看不出哪裡有公式，後學光看那些程式碼就快....，您都可以套用寫出，建議將原來有公式區可以轉成VBA，
這樣也可以提升效率，謝謝

TOP

s3526369
　暱稱: 大榮

中學生Rank: 2

帖子
45 
主題
3 
精華
0 
積分
72 
點名
0  
作業系統
WIN7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2018-2-12 
最後登錄
2024-7-15 
33#
發表於 2022-9-17 00:14 | 只看該作者
本帖最後由 s3526369 於 2022-9-17 00:16 編輯

回復 32# samwang

前輩你好~我倉庫庫存A.B是連結材料表的資料,我重新上傳附件!

倉庫合計TEST2.rar (626.37 KB)

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2024-10-30 
34#
發表於 2022-9-17 06:57 | 只看該作者
回復  samwang

前輩你好~我倉庫庫存A.B是連結材料表的資料,我重新上傳附件!
s3526369 發表於 2022-9-17 00:14


請測試看看，謝謝

倉庫合計TEST2_0917.zip (627.58 KB)

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
35#
發表於 2022-9-17 09:56 | 只看該作者
太厲害了!
33# 祥龍十八掌
34# 打通任督二脈

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
36#
發表於 2022-9-17 16:48 | 只看該作者
回復 33# s3526369


    提醒前輩
下方紅字處須改為2

Sub 倉庫庫存()
Dim Arr, xD, xD1, xD2, xD3, xD4, xD5, xD6, xD7, T$, i&, QA, QB
Set xD = CreateObject("Scripting.Dictionary")   '入庫合計
Set xD1 = CreateObject("Scripting.Dictionary")  '公司總需求
Set xD2 = CreateObject("Scripting.Dictionary")  'A倉
Set xD3 = CreateObject("Scripting.Dictionary")  'B倉
Set xD4 = CreateObject("Scripting.Dictionary")  '總出貨
Set xD5 = CreateObject("Scripting.Dictionary")  '盤點數'
Set xD6 = CreateObject("Scripting.Dictionary") '退庫
Set xD7 = CreateObject("Scripting.Dictionary")  '廢料
TM = Timer
With Sheets("入庫明細")
    Arr = .Range(.[r1], .[o65536].End(3))
    For i = 2 To UBound(Arr)
        T = Arr(i, 1): xD(T) = xD(T) + Arr(i, 4) '入庫合計
    Next
End With
With Sheets("全機種BOM")
    Arr = .Range(.[Z1], .[p65536].End(3))
    For i = 2 To UBound(Arr)
        T = Arr(i, 1): xD1(T) = xD1(T) + Arr(i, 11) '公司總需求
    Next
End With
With Sheets("A需求")
    Arr = .Range(.[h1], .[A65536].End(3))
    For i = 4 To UBound(Arr)
        T = Arr(i, 1): xD2(T) = xD2(T) + Arr(i, 8)  'A倉
    Next
End With
With Sheets("B需求")
    Arr = .Range(.[h1], .[A65536].End(3))
    For i = 4 To UBound(Arr)
        T = Arr(i, 1): xD3(T) = xD3(T) + Arr(i, 8)  'B倉
    Next
End With
With Sheets("指圖明細")
    Arr = .Range(.[L1], .[f65536].End(3))
    For i = 4 To UBound(Arr)
        T = Arr(i, 1): xD4(T) = xD4(T) + Arr(i, 7)  '總出貨
    Next
End With
With Sheets("公司盤點")
    Arr = .Range(.[G1], .[A65536].End(3))
    For i = 4 To UBound(Arr)
        T = Arr(i, 1): xD5(T) = xD5(T) + Arr(i, 7)  '公司盤點
    Next
End With

With Sheets("退庫")
    Arr = .Range(.[C1], .[A65536].End(3))
    For i = 3 To UBound(Arr)
        T = Arr(i, 1): xD6(T) = xD6(T) + Arr(i, 3)  'B倉
    Next
End With
With Sheets("廢料倉")
    Arr = .Range(.[C1], .[A65536].End(3))
    For i = 3 To UBound(Arr)
        T = Arr(i, 1): xD7(T) = xD7(T) + Arr(i, 3)  'B倉
    Next
End With

With Sheets("倉庫庫存")
    Arr = .Range(.[m3], .[A65536].End(3))
    For i = 2 To UBound(Arr)
        T = Arr(i, 1)
        QA = xD5(T) + xD(T) ' ''倉庫庫存
        QB = xD6(T) + xD7(T)
        Arr(i, 5) = xD(T)    '入庫合計
        Arr(i, 13) = xD4(T)  '總出貨
        Arr(i, 3) = xD1(T)   '總需求
        Arr(i, 8) = QA - QB - xD2(T) - xD3(T) - xD4(T)  '公司倉
        Arr(i, 9) = xD3(T)   'B倉
        Arr(i, 10) = xD2(T)  'A倉
        Arr(i, 7) = QA - QB - xD4(T)  '總數
        Arr(i, 4) = xD5(T)
        Arr(i, 11) = xD6(T)
        Arr(i, 12) = xD7(T)
        
        If Arr(i, 3) > 0 Then
        XA = xD5(T) + xD(T) - xD6(T) - xD7(T) - Arr(i, 3)
            If XA >= 0 Then XA = "0"
        Else
            XA = "0"
        End If
        If xD(T) = 0 Then Arr(i, 5) = "0"
        If xD5(T) = 0 Then Arr(i, 4) = "0"
        If xD1(T) = 0 Then Arr(i, 3) = "0"
        If xD4(T) = 0 Then Arr(i, 13) = "0"
   Arr(i, 6) = XA
    Next
    .[a3].Resize(UBound(Arr), 13) = Arr
End With
'MsgBox "共耗時：" & Timer - TM & " 秒"
End Sub

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
37#
發表於 2022-9-17 16:58 | 只看該作者
謝謝 兩位前輩
今天習得
1.倒入字典迴圈化
2.預設2條件吻合才加總
  1. Option Explicit
  2. Sub 倉庫庫存_20220917()
  3. Application.ScreenUpdating = False
  4. Dim x&, i&, 值(1 To 17) As Long, QA, QB, T, S, Srr, Arr, Ac, xR, C
  5. Dim Trr, Brr, Crr, Rs, Rq1s, Rq1n, Ras, Ran, B, 欄d, 特rr, Drr
  6. Dim Rq2s, Rq2n, XA
  7. T = Timer
  8. Set Srr = CreateObject("Scripting.Dictionary")
  9. Set Trr = CreateObject("Scripting.Dictionary")
  10. Set 特rr = CreateObject("Scripting.Dictionary")
  11.       '        0        1       2        3     4       5       6      7     8
  12. S = Split("倉庫庫存,入庫明細,全機種BOM,A需求,B需求,指圖明細,公司盤點,退庫,廢料倉", ",")
  13. For i = 1 To UBound(S)
  14.    Set Srr(i) = Sheets(S(i))
  15.    Set Trr(i) = CreateObject("Scripting.Dictionary")
  16.    Set 特rr(i) = CreateObject("Scripting.Dictionary")
  17. Next
  18. Rs = Rows.Count
  19. Ac = Sheets(S(0)).Cells(Rs, 1).End(3).Row
  20. Arr = Range(Sheets(S(0)).[N4], Sheets(S(0)).Cells(Ac, 1))
  21.                   'vS, vC,zS, zC,xS,xC,zS, zC,zV
  22. 特rr(1) = Array("", 1, 18, 1, 15, 0, 1, 1, 99, "") '入庫合計
  23. 特rr(2) = Array("", 2, 26, 2, 16, 0, 1, 2, 99, "") '公司總需求
  24. 特rr(3) = Array("", 3, 8, 3, 1, 0, 1, 3, 99, "") 'A倉
  25. 特rr(4) = Array("", 4, 8, 4, 1, 0, 1, 4, 99, "")  'B倉
  26. 特rr(5) = Array("", 5, 12, 5, 6, 0, 1, 5, 99, "") '總出貨
  27. 特rr(6) = Array("", 6, 7, 6, 1, 0, 1, 6, 99, "")  '公司盤點
  28. 特rr(7) = Array("", 7, 3, 7, 1, 0, 1, 7, 99, "")  'B倉
  29. 特rr(8) = Array("", 8, 3, 8, 1, 0, 1, 8, 99, "")  'B倉
  30. For i = 1 To UBound(S)
  31.    Set Rq1s = Srr(特rr(i)(3)).Cells(1, 特rr(i)(4))
  32.    Set Rq1n = Srr(特rr(i)(3)).Cells(Rs, 特rr(i)(4)).End(3)
  33.    Brr = Srr(特rr(i)(3)).Range(Rq1s, Rq1n)
  34.    
  35.    Set Rq2s = Srr(特rr(i)(7)).Cells(1, 特rr(i)(8))
  36.    Set Rq2n = Srr(特rr(i)(7)).Cells(Rq1n.Row, 特rr(i)(8))
  37.    Drr = Srr(特rr(i)(7)).Range(Rq2s, Rq2n)

  39.    Set Ras = Srr(特rr(i)(1)).Cells(1, 特rr(i)(2))
  40.    Set Ran = Srr(特rr(i)(1)).Cells(Rq1n.Row, 特rr(i)(2))
  41.    Crr = Srr(特rr(i)(1)).Range(Ras, Ran)
  42.    For x = 1 To UBound(Brr)
  43.       B = Brr(x, 1)
  44.       If InStr(Drr(x, 1), 特rr(i)(9)) Or Drr(x, 1) & 特rr(i)(9) = "" Then
  45.          Trr(i)(B) = Trr(i)(B) + Crr(x, 1)
  46.       End If
  47.    Next
  48. Next
  49. For i = 1 To Ac - 3
  50.    xR = Arr(i, 1)
  51.    QA = Trr(1)(xR) + Trr(6)(xR) '倉庫庫存
  52.    QB = Trr(7)(xR) + Trr(8)(xR)
  53.    Arr(i, 5) = Trr(1)(xR)    '入庫合計
  54.    Arr(i, 13) = Trr(5)(xR)  '總出貨
  55.    Arr(i, 3) = Trr(2)(xR)   '總需求
  56.    Arr(i, 8) = QA - QB - Trr(3)(xR) - Trr(4)(xR) - Trr(5)(xR) '公司倉
  57.    Arr(i, 9) = Trr(4)(xR)   'B倉
  58.    Arr(i, 10) = Trr(3)(xR)  'A倉
  59.    Arr(i, 7) = QA - QB - Trr(5)(xR)  '總數
  60.    Arr(i, 4) = Trr(6)(xR)
  61.    Arr(i, 11) = Trr(7)(xR)
  62.    Arr(i, 12) = Trr(8)(xR)
  63.    If Arr(i, 3) > 0 Then
  64.       XA = Trr(6)(xR) + Trr(1)(xR) - Trr(7)(xR) - Trr(8)(xR) - Arr(i, 3)
  65.       If XA >= 0 Then XA = 0
  66.       Else
  67.          XA = 0
  68.    End If
  69.    If Trr(1)(xR) = 0 Then Arr(i, 5) = 0
  70.    If Trr(6)(xR) = 0 Then Arr(i, 4) = 0
  71.    If Trr(2)(xR) = 0 Then Arr(i, 3) = 0
  72.    If Trr(5)(xR) = 0 Then Arr(i, 13) = 0
  73.    Arr(i, 6) = XA
  74. Next i
  75. C = Array(, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)
  76. For i = 1 To UBound(C)
  77.    Sheets(S(0)).Cells(4, C(i)).Resize(UBound(Arr), 1) = Application.Index(Arr, , C(i))
  78. Next
  79. MsgBox "共耗時：" & Timer - T & " 秒"
  80. End Sub
複製代碼

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
38#
發表於 2022-9-19 10:35 | 只看該作者
回復 37# Andy2483


        謝謝論壇
        謝謝各位前輩
異想天開!測試OK
Set Srr(i) = Sheets(S(i))
改為
Set Srr(i) = Sheets(S(i)).Cells
後方的Cells都可以省略
  1. Option Explicit
  2. Sub 倉庫庫存_20220919()
  3. Application.ScreenUpdating = False
  4. Dim x&, i&, QA, QB, T, S, Srr, Arr, Ac, xR, C
  5. Dim Trr, Brr, Crr, Rs, Rq1s, Rq1n, Ras, Ran, B, 特rr, Drr
  6. Dim Rq2s, Rq2n, XA
  7. T = Timer
  8. Set Srr = CreateObject("Scripting.Dictionary")
  9. Set Trr = CreateObject("Scripting.Dictionary")
  10. Set 特rr = CreateObject("Scripting.Dictionary")
  11.       '        0        1       2        3     4       5       6      7     8
  12. S = Split("倉庫庫存,入庫明細,全機種BOM,A需求,B需求,指圖明細,公司盤點,退庫,廢料倉", ",")
  13. For i = 1 To UBound(S)
  14.    Set Srr(i) = Sheets(S(i)).Cells
  15.    Set Trr(i) = CreateObject("Scripting.Dictionary")
  16.    Set 特rr(i) = CreateObject("Scripting.Dictionary")
  17. Next
  18. Rs = Rows.Count
  19. Ac = Sheets(S(0)).Cells(Rs, 1).End(3).Row
  20. Arr = Range(Sheets(S(0)).[N4], Sheets(S(0)).Cells(Ac, 1))
  21.                   'vS, vC,zS, zC,xS,xC,zS, zC,zV
  22. 特rr(1) = Array("", 1, 18, 1, 15, 0, 1, 1, 99, "") '入庫合計
  23. 特rr(2) = Array("", 2, 26, 2, 16, 0, 1, 2, 99, "") '公司總需求
  24. 特rr(3) = Array("", 3, 8, 3, 1, 0, 1, 3, 99, "") 'A倉
  25. 特rr(4) = Array("", 4, 8, 4, 1, 0, 1, 4, 99, "")  'B倉
  26. 特rr(5) = Array("", 5, 12, 5, 6, 0, 1, 5, 99, "") '總出貨
  27. 特rr(6) = Array("", 6, 7, 6, 1, 0, 1, 6, 99, "")  '公司盤點
  28. 特rr(7) = Array("", 7, 3, 7, 1, 0, 1, 7, 99, "")  'B倉
  29. 特rr(8) = Array("", 8, 3, 8, 1, 0, 1, 8, 99, "")  'B倉
  30. For i = 1 To UBound(S)
  31.    Set Rq1s = Srr(特rr(i)(3))(1, 特rr(i)(4))
  32.    Set Rq1n = Srr(特rr(i)(3))(Rs, 特rr(i)(4)).End(3)
  33.    Brr = Srr(特rr(i)(3)).Range(Rq1s, Rq1n)
  34.   
  35.    Set Rq2s = Srr(特rr(i)(7))(1, 特rr(i)(8))
  36.    Set Rq2n = Srr(特rr(i)(7))(Rq1n.Row, 特rr(i)(8))
  37.    Drr = Srr(特rr(i)(7)).Range(Rq2s, Rq2n)

  39.    Set Ras = Srr(特rr(i)(1))(1, 特rr(i)(2))
  40.    Set Ran = Srr(特rr(i)(1))(Rq1n.Row, 特rr(i)(2))
  41.    Crr = Srr(特rr(i)(1)).Range(Ras, Ran)
  42.    For x = 1 To UBound(Brr)
  43.       B = Brr(x, 1)
  44.       If InStr(Drr(x, 1), 特rr(i)(9)) Or Drr(x, 1) & 特rr(i)(9) = "" Then
  45.          Trr(i)(B) = Trr(i)(B) + Crr(x, 1)
  46.       End If
  47.    Next
  48. Next
  49. For i = 1 To Ac - 3
  50.    xR = Arr(i, 1)
  51.    QA = Trr(1)(xR) + Trr(6)(xR) '倉庫庫存
  52.    QB = Trr(7)(xR) + Trr(8)(xR)
  53.    Arr(i, 5) = Trr(1)(xR)    '入庫合計
  54.    Arr(i, 13) = Trr(5)(xR)  '總出貨
  55.    Arr(i, 3) = Trr(2)(xR)   '總需求
  56.    Arr(i, 8) = QA - QB - Trr(3)(xR) - Trr(4)(xR) - Trr(5)(xR) '公司倉
  57.    Arr(i, 9) = Trr(4)(xR)   'B倉
  58.    Arr(i, 10) = Trr(3)(xR)  'A倉
  59.    Arr(i, 7) = QA - QB - Trr(5)(xR)  '總數
  60.    Arr(i, 4) = Trr(6)(xR)
  61.    Arr(i, 11) = Trr(7)(xR)
  62.    Arr(i, 12) = Trr(8)(xR)
  63.    If Arr(i, 3) > 0 Then
  64.       XA = Trr(6)(xR) + Trr(1)(xR) - Trr(7)(xR) - Trr(8)(xR) - Arr(i, 3)
  65.       If XA >= 0 Then XA = 0
  66.       Else
  67.          XA = 0
  68.    End If
  69.    If Trr(1)(xR) = 0 Then Arr(i, 5) = 0
  70.    If Trr(6)(xR) = 0 Then Arr(i, 4) = 0
  71.    If Trr(2)(xR) = 0 Then Arr(i, 3) = 0
  72.    If Trr(5)(xR) = 0 Then Arr(i, 13) = 0
  73.    Arr(i, 6) = XA
  74. Next i
  75. C = Array(, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)
  76. For i = 1 To UBound(C)
  77.    Sheets(S(0)).Cells(4, C(i)).Resize(UBound(Arr), 1) = Application.Index(Arr, , C(i))
  78. Next
  79. MsgBox "共耗時：" & Timer - T & " 秒"
  80. End Sub
複製代碼

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
39#
發表於 2022-9-19 13:19 | 只看該作者
回復 33# s3526369


    提醒前輩關於 Sub A需求()
1.Arr(i, 3) 沒有填入值
2.xD3字典創建後沒有被使用
3.求出的值與 初始的範例  倉庫合計.rar  有差異

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
40#
發表於 2022-9-19 13:25 | 只看該作者
謝謝 兩位前輩
今天習得
1.倒入字典迴圈化
2.預設2條件吻合才加總
Andy2483 發表於 2022-9-17 16:58


2.預設2條件吻合才加總套入 A需求 可以用
  1. Option Explicit
  2. Sub A需求_20220919()
  3. Application.ScreenUpdating = False
  4. Dim x&, i&, QA, QB, T, S, Srr, Arr, Ac, xR, C
  5. Dim Trr, Brr, Crr, Rs, Rq1s, Rq1n, Ras, Ran, B, 特rr, Drr
  6. Dim Rq2s, Rq2n, XA
  7. T = Timer
  8. Set Srr = CreateObject("Scripting.Dictionary")
  9. Set Trr = CreateObject("Scripting.Dictionary")
  10. Set 特rr = CreateObject("Scripting.Dictionary")
  11.       '        0     1       2        3        4         5        6        7
  12. S = Split("A需求,入庫明細,出庫明細,全機種BOM,指圖明細,公司盤點,公司盤點,公司盤點", ",")
  13. For i = 1 To UBound(S)
  14.    Set Srr(i) = Sheets(S(i)).Cells
  15.    Set Trr(i) = CreateObject("Scripting.Dictionary")
  16.    Set 特rr(i) = CreateObject("Scripting.Dictionary")
  17. Next
  18. Rs = Rows.Count
  19. Ac = Sheets(S(0)).Cells(Rs, 1).End(3).Row
  20. Arr = Range(Sheets(S(0)).[H4], Sheets(S(0)).Cells(Ac, 1))
  21.                   'vS, vC,zS, zC,xS,xC,zS, zC,zV
  22. 特rr(1) = Array("", 1, 18, 1, 15, 0, 1, 1, 19, "A倉") '入庫合計
  23. 特rr(2) = Array("", 2, 18, 2, 15, 0, 1, 2, 19, "A倉") '出庫合計
  24. 特rr(3) = Array("", 3, 26, 3, 16, 0, 1, 3, 20, "A倉") '全機種BOM-總需求
  25. 特rr(4) = Array("", 4, 12, 4, 6, 0, 1, 4, 10, "A倉")  '指圖明細-總出貨
  26. 特rr(5) = Array("", 5, 6, 5, 1, 0, 1, 5, 99, "") '公司盤點-A倉
  27. 特rr(6) = Array("", 6, 11, 6, 1, 0, 1, 6, 99, "")  '公司盤點-A倉調整
  28. 特rr(7) = Array("", 7, 7, 7, 1, 0, 1, 7, 99, "")  '盤點表
  29. For i = 1 To UBound(S)
  30.    Set Rq1s = Srr(特rr(i)(3))(1, 特rr(i)(4))
  31.    Set Rq1n = Srr(特rr(i)(3))(Rs, 特rr(i)(4)).End(3)
  32.    Brr = Srr(特rr(i)(3)).Range(Rq1s, Rq1n)
  33.    
  34.    Set Rq2s = Srr(特rr(i)(7))(1, 特rr(i)(8))
  35.    Set Rq2n = Srr(特rr(i)(7))(Rq1n.Row, 特rr(i)(8))
  36.    Drr = Srr(特rr(i)(7)).Range(Rq2s, Rq2n)

  38.    Set Ras = Srr(特rr(i)(1))(1, 特rr(i)(2))
  39.    Set Ran = Srr(特rr(i)(1))(Rq1n.Row, 特rr(i)(2))
  40.    Crr = Srr(特rr(i)(1)).Range(Ras, Ran)
  41.    For x = 1 To UBound(Brr)
  42.       B = Brr(x, 1)
  43.       If InStr(Drr(x, 1), 特rr(i)(9)) Or Drr(x, 1) & 特rr(i)(9) = "" Then
  44.          Trr(i)(B) = Trr(i)(B) + Crr(x, 1)
  45.       End If
  46.    Next
  47. Next
  48. For i = 1 To Ac - 3
  49.    xR = Arr(i, 1)
  50.    Arr(i, 4) = Trr(7)(xR)
  51.    Arr(i, 5) = Trr(3)(xR)
  52.    Arr(i, 6) = Trr(1)(xR) + Trr(2)(xR)
  53.    Arr(i, 8) = Trr(5)(xR) + Trr(6)(xR)
  54.    If Trr(3)(xR) = 0 Then Arr(i, 5) = 0
  55.    If Trr(7)(xR) = 0 Then Arr(i, 4) = 0
  56.    If Trr(1)(xR) + Trr(2)(xR) = 0 Then Arr(i, 6) = 0
  57.    If Trr(5)(xR) + Trr(6)(xR) = 0 Then Arr(i, 8) = 0
  58.    Arr(i, 7) = Trr(5)(xR) + Trr(6)(xR) + Trr(1)(xR) + Trr(2)(xR) - Trr(3)(xR)
  59.    If Arr(i, 7) >= 0 Then Arr(i, 7) = 0
  60. Next i
  61. Sheets(S(0)).[A4].Resize(UBound(Arr), 8) = Arr
  62. MsgBox "共耗時：" & Timer - T & " 秒"
  63. End Sub
複製代碼

TOP

        靜思自在 : 唯其尊重自己的人，才更勇於縮小自己。
12345
返回列表 上一主題