可否協助簡化程式

周大偉

各高人, 好
小弟錄制了一個程式, 使用沒有問題, 但程式頗長, 而使用時介面閃動, 此錄制程式可有簡化空間, 請高人們協助, 謝謝!!

Sub 更新()
'
' 資料更新 巨集
'

'
    Windows("abc倉庫資料.xlsm").Activate
    Sheets("總公司倉庫").Select
    Range("J4").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMIFS([提取單.xlsm]提取單!C7,[提取單.xlsm]提取單!C15,RC7,[提取單.xlsm]提取單!C3,RC2)+SUMIFS([提取單.xlsm]提取單!R3C7,[提取單.xlsm]提取單!R3C15,RC[-3],[提取單.xlsm]提取單!R3C3,RC[-8])+SUMIFS([提取單.xlsm]提取單!R3C7,[提取單.xlsm]提取單!R3C15,RC[-3],[提取單.xlsm]提取單!R3C3,RC[-8])"
    Range("K4").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMIFS([入貨單.xlsm]Sheet1!C8,[入貨單.xlsm]Sheet1!C13,RC7,[入貨單.xlsm]Sheet1!C3,RC2)+SUMIFS([入貨單.xlsm]Sheet1!R3C8,[入貨單.xlsm]Sheet1!R3C13,RC[-4],[入貨單.xlsm]Sheet1!R3C3,RC[-9])"
    Range("L4").Select
    ActiveCell.FormulaR1C1 = "=RC[-3]-RC[-2]+RC[-1]"
    ActiveWorkbook.Save
    Range("J4:L4").Select
    Selection.AutoFill Destination:=Range("J4:L22"), Type:=xlFillDefault
    Range("J4:L22").Select
    Range("L22").Select
    Sheets("分公司倉庫").Select
    Range("J4").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMIFS([提取單.xlsm]提取單!C7,[提取單.xlsm]提取單!C15,RC7,[提取單.xlsm]提取單!C3,RC2)+SUMIFS([提取單.xlsm]提取單!R3C7,[提取單.xlsm]提取單!R3C15,RC[-3],[提取單.xlsm]提取單!R3C3,RC[-8])"
    Range("K4").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMIFS([入貨單.xlsm]Sheet1!C8,[入貨單.xlsm]Sheet1!C13,RC7,[入貨單.xlsm]Sheet1!C3,RC2)+SUMIFS([入貨單.xlsm]Sheet1!R3C8,[入貨單.xlsm]Sheet1!R3C13,RC[-4],[入貨單.xlsm]Sheet1!R3C3,RC[-9])"
    Range("L4").Select
    ActiveCell.FormulaR1C1 = "=RC[-3]-RC[-2]+RC[-1]"
    ActiveWorkbook.Save
    Range("J4:L4").Select
    Selection.AutoFill Destination:=Range("J4:L22"), Type:=xlFillDefault
    Range("J4:L22").Select
    Range("L22").Select
     Sheets("總公司倉庫").Select
    Range("J4:L22").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L4").Select
    Application.CutCopyMode = False
    Sheets("分公司倉庫").Select
    Range("J4:L22").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L4").Select
    Application.CutCopyMode = False
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    Windows("提取單.xlsm").Activate
    Range("A2").Select
End Sub

joey0415

回復 1# 周大偉

分段錄制，分段簡化，你會更有成就感

lpk187

回復 1# 周大偉


    版主的這篇可以參考
http://forum.twbts.com/viewthrea ... p%3Bfilter%3Ddigest

周大偉

回復 3# lpk187                                                                     小弟所識有限，上述提及文章也曾參考，但功力太淺，故把此錄制巨集上傳，希望得到回應，最後謝謝提示，祝快樂。 此文手機覆，字體位置偏離，見諒。

lpk187

回復 4# 周大偉

沒檔案可以試，也不知對不對！

1. Sub 更新()
   
2. '
   
3. ' 資料更新 巨集
   
4. '
   
5. 
   
6. '
   
7.     Windows("abc倉庫資料.xlsm").Activate
   
8.     Sheets("總公司倉庫").Select
   
9.     Range("J4") = "=SUMIFS([提取單.xlsm]提取單!C7,[提取單.xlsm]提取單!C15,RC7,[提取單.xlsm]提取單!C3,RC2)+SUMIFS([提取單.xlsm]提取單!R3C7,[提取單.xlsm]提取單!R3C15,RC[-3],[提取單.xlsm]提取單!R3C3,RC[-8])+SUMIFS([提取單.xlsm]提取單!R3C7,[提取單.xlsm]提取單!R3C15,RC[-3],[提取單.xlsm]提取單!R3C3,RC[-8])"
   
10.     Range("K4") = "=SUMIFS([入貨單.xlsm]Sheet1!C8,[入貨單.xlsm]Sheet1!C13,RC7,[入貨單.xlsm]Sheet1!C3,RC2)+SUMIFS([入貨單.xlsm]Sheet1!R3C8,[入貨單.xlsm]Sheet1!R3C13,RC[-4],[入貨單.xlsm]Sheet1!R3C3,RC[-9])"
    
11.     Range("L4") = "=RC[-3]-RC[-2]+RC[-1]"
    
12.     ActiveWorkbook.Save
    
13.     Range("J4:L4").AutoFill Destination:=Range("J4:L22"), Type:=xlFillDefault
    
14.     Range("L22").Select
    
15.     Sheets("分公司倉庫").Select
    
16.     Range("J4") = "=SUMIFS([提取單.xlsm]提取單!C7,[提取單.xlsm]提取單!C15,RC7,[提取單.xlsm]提取單!C3,RC2)+SUMIFS([提取單.xlsm]提取單!R3C7,[提取單.xlsm]提取單!R3C15,RC[-3],[提取單.xlsm]提取單!R3C3,RC[-8])"
    
17.     Range("K4") = "=SUMIFS([入貨單.xlsm]Sheet1!C8,[入貨單.xlsm]Sheet1!C13,RC7,[入貨單.xlsm]Sheet1!C3,RC2)+SUMIFS([入貨單.xlsm]Sheet1!R3C8,[入貨單.xlsm]Sheet1!R3C13,RC[-4],[入貨單.xlsm]Sheet1!R3C3,RC[-9])"
    
18.     Range("L4") = "=RC[-3]-RC[-2]+RC[-1]"
    
19.     ActiveWorkbook.Save
    
20.     Range("J4:L4").AutoFill Destination:=Range("J4:L22"), Type:=xlFillDefault
    
21.     Sheets("總公司倉庫").Select
    
22.     Range("J4:L22").Copy
    
23.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
24.         :=False, Transpose:=False
    
25.     Range("L4").Select
    
26.     Application.CutCopyMode = False
    
27.     Sheets("分公司倉庫").Select
    
28.     Range("J4:L22").Copy
    
29.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
30.         :=False, Transpose:=False
    
31.     Range("L4").Select
    
32.     Application.CutCopyMode = False
    
33.     ActiveWindow.ScrollRow = 5
    
34.     ActiveWindow.ScrollRow = 4
    
35.     Windows("提取單.xlsm").Activate
    
36.     Range("A2").Select
    
37. End Sub

複製代碼

周大偉

回復 5# lpk187
謝謝回應, 祝願快樂..