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

標題: [發問] 巨集執行愈來愈慢? [打印本頁]

作者: adam2010 時間: 2015-9-9 23:49 標題: 巨集執行愈來愈慢?

小弟有一個排程的巨集，之前也是請教這裡的高手stillfish00協助解決的
不知道是不是電腦老舊還是資料量過大，使用一段時間之後這一段愈跑愈慢 ( 用公司的NB跑將近6~7分鐘 )
想請教各位高手是否有加速的方法，或者其實是因為其他部分我自行錄製拼湊出來的段落影響所以才會愈來愈慢?

[attach]21936[/attach]

         Dim s1 As Long, s2 As Long
         Dim cindex As Long
         With Sheets("出貨日")
         Set Rng = .Range(.[a1], .[a1].End(xlToRight).End(xlDown).Offset(, -1))  '[出貨日]資料範圍
         End With
         For Each c In Sheets("交期").Range("E2:E" & Sheets("交期").[a1].End(xlDown).Row)  '[交期]資料填入範圍
         If c.Offset(, -4).Value <> c.Offset(-1, -4).Value Then
            cindex = 1
            s1 = 0  '累積至前一批數量
            s2 = 0  '累積出貨需求數量
         Else
            s1 = s1 + c.Offset(-1, -1).Value
         End If
         Do While s2 <= s1
            cindex = cindex + 1
            If Application.IsError(Application.VLookup(c.Offset(, -4).Value, Rng, cindex, False)) Then
                  Exit Do
            Else
                  s2 = s2 + Application.VLookup(c.Offset(, -4).Value, Rng, cindex, False)
            End If
         Loop
         If s2 <= s1 Then
            c.Value = "NA"
         Else
            c.Value = Rng.Cells(1, cindex).Value
         End If
         Next
         Set Rng = Nothing
'在E欄填入交期

作者: r1145kimo 時間: 2015-9-10 04:56

本帖最後由 r1145kimo 於 2015-9-10 04:58 編輯

版大您好,小弟不才試著回答,由於EXCEL 每個CELL有更改的話會全部自動重新計算一次,故於迴圈執行前先關閉自動重算,迴圈結束後再行開

作者: r1145kimo 時間: 2015-9-10 05:06

本帖最後由 r1145kimo 於 2015-9-10 05:08 編輯

版大您好,小弟不才試著回答,由於EXCEL 每個CELL有更改的話會全部自動重新計算一次,故於迴圈執行前先關閉自動 ...
r1145kimo 發表於 2015-9-10 04:56

版大您好,
由於EXCEL 每個CELL有更改會全部自動重新計算一次,故於迴圈執行前先關閉自動重算
執行後再打開自動重算即可~附上語法

作者: stillfish00 時間: 2015-9-10 10:38

回復 1# adam2010
6-7分鐘是跑多大資料量的時間? 應該不是指跑你的附檔的速度吧
另外原帖H大有提供字典方法，跑大量時應該會快得多。

http://forum.twbts.com/viewthrea ... p;extra=&page=2

作者: 准提部林 時間: 2015-9-10 12:41

回復 1# adam2010

１．錄製碼本來執行就慢，尤其含有太多的 Select，須整理為更有效的方式，
　　不同需求的程式，應分別以 sub 建立單獨程序，要引用時 call 一下即可，
　　像 Sheets("WIP") 部份，實可獨立成單一程序！
　　但因不了解處理需求流程，且部份語法在office 2000無法使用，所以無法幫忙整理！
２．僅針對〔交期〕工作表提供個人不正規的寫法，可單獨測試其執行速度，
　　另執行結果與原檔程式的結果有部份不相同（Ｌ欄標示紅字者），請檢查一下！
３．另提供相同資料配底色程式，視覺上較易分辨各編號的起迄區塊！

Sub 交期()
Dim R&, C&, Arr, Brr, DateRow, xD, i&, j&, SS&, S&, T$, M
R = [出貨日!A65535].End(xlUp).Row - 1
C = [出貨日!IV1].End(xlToLeft).Column - 1
Arr = [出貨日!A1].Resize(R, C)
ReDim Brr(1 To C - 1)
Set xD = CreateObject("Scripting.Dictionary")
For j = 2 To C: Brr(C - j + 1) = Arr(1, j): Next j: DateRow = Brr 　'日期由大而小倒轉
　
For i = 2 To R
　For j = 2 To C　 '數量累計〔由後而前〕排入陣列
　　　S = Val(Arr(i, j)): SS = SS + S
　　　If S = 0 Then Brr(C - j + 1) = "" Else Brr(C - j + 1) = SS
　Next j
　If SS > 0 Then xD(Arr(i, 1)) = Brr: SS = 0　 '將累計數列納入字典檔
101: Next i
'======================================================
R = [交期!A65535].End(xlUp).Row
Arr = [交期!A1].Resize(R, 4)
ReDim Brr(1 To R, 0): Brr(1, 0) = "交期"
For i = 2 To R
　　T = Arr(i, 1): S = Arr(i, 4)
　　If T <> Arr(i - 1, 1) Then SS = S Else SS = SS + S 　'Ａ欄相同，累計，反之，取當前數量
　　M = Application.Match(SS, xD(T), -1) 　 '利用MATCH〔反序〕找相對位置
　　If S = 0 Or IsError(M) Then Brr(i, 0) = "NA" Else Brr(i, 0) = DateRow(M)　 '無符合填NA，否則填日期
Next i
[交期!E1].Resize(R) = Brr
End Sub

複製代碼

附件下載：
[attach]21942[/attach]
　

作者: adam2010 時間: 2015-9-10 21:11

回復 3# r1145kimo

r1145kimo大，感謝您的回復，放上去之後真得快了很多
是所有的迴圈函數都可以用嗎?
那可不可以一開始執行巨集就關閉，最後執行完畢存檔之前再打開?

作者: adam2010 時間: 2015-9-10 21:24

回復 4# stillfish00

Dear stillfish00大，就是跑附檔的資料(一千多筆)而已
之前H大提供的語法，出現錯誤在第七行的地方
Set rng = a.EntireRow.SpecialCells(xlCellTypeConstants, xlNumbers) '應交貨數量
因為不太懂語法，實在找不出哪裡有問題所以就沒有使用了
而一開始您所提供的迴圈執行也蠻快的，所以就這樣使用，
可能是我後來又陸續錄製一些新增的功能影響了這一段迴圈的執行速度
剛才聽r1145kimo大的建議已經快很多了，再次感謝您出手相助~

作者: adam2010 時間: 2015-9-10 21:33

回復 5# 准提部林

感謝准提部林大提供的建議 & Sample
因為不太懂語法，所以先求加速一點即可不敢大肆修改
但是您提供的範例也帶給我其他工作的一些新想法，謝謝您~

作者: r1145kimo 時間: 2015-9-14 07:54

本帖最後由 r1145kimo 於 2015-9-14 07:56 編輯

回復 6# adam2010
只要在輸出結果之前開

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