返回列表 上一主題 發帖

[發問] 要如何改善這個檔案的效能(重算儲存格)

回復 1# nifanliu
檔案關閉前  執行
  1. Sub Ex()   '公式轉為值:公式減少,重算儲存格時間縮短
  2.     Dim R As Integer
  3.     With Sheets("Shipping_PO").UsedRange     'Shipping_PO
  4.         For Each e In .Columns
  5.             Names.Add Chr(64 + e.Column) & "欄", e.Offset(1).Address(, , , 1)
  6.            '名稱定義 為 A欄,B欄,,C欄,D欄,E欄
  7.         Next
  8.     End With
  9.    
  10.     With Sheets("PO")
  11.         .Activate
  12.         [I2].Select
  13.         Names.Add "IA", "=!RC[-8]"    '名稱定義 相對 [I2] 於 -8欄 的位置
  14.         [I2].Select
  15.         Names.Add "IC", "=!RC[-6]"    '名稱定義 相對 [I2] 於 -6欄 的位置
  16.         [L2].Select
  17.         Names.Add "LA", "=!RC[-11]"
  18.         [L2].Select
  19.         Names.Add "LC", "=!RC[-9]"
  20.         R = .[a1].End(xlDown).End(xlDown).End(xlUp).Row
  21.         If R = 1 Then R = 2
  22.         .Range("F2:F" & R) = "=RC[-1]/RC[-2]"       '=E2/D2
  23.                            
  24.         .Range(" G2:G" & R) = "=RC[-1]/(VALUE(LEFT(RC[-4],2))*(VALUE(RIGHT(RC[-4],2)))*(0.0254^2))"
  25.                                 '=F2/(VALUE(LEFT(C2,2))*(VALUE(RIGHT(C2,2)))*(0.0254^2))
  26.                         
  27.         .Range("H2:H" & R) = "=RC[-2]*29.5*1000"       '=F2*29.5*1000
  28.                                 
  29.         .Range("I2:I" & R) = "=SUMPRODUCT((" & [B欄] & "=IA)*(" & [D欄] & "=IC)," & [E欄] & ")"
  30.                         '=SUMPRODUCT((Shipping_PO!$A$2:$A$65=A3)*(Shipping_PO!$D$2:$D$65=C3),Shipping_PO!$E$2:$E$65)
  31.             
  32.         .Range("J2:J" & R) = "=RC[-6]-RC[-1]"                           '=D2-I2
  33.             
  34.         .Range("K2:K" & R) = "=IF(RC[-1]>0,""Open"",""Close"")"            '=IF( J2>0, "Open","Close")
  35.         
  36.         .Range("L2:L" & R) = "=SUMPRODUCT((" & [B欄] & "=LA)*(" & [D欄] & "=LC)*(MONTH(" & [C欄] & ")=MONTH(TODAY()))," & [E欄] & ")"
  37.                         '=SUMPRODUCT((Shipping_PO!$B$2:$B$65536=A2)*(Shipping_PO!$D$2:$D$65536=C2)*(MONTH(Shipping_PO!$C$2:$C$65536)=MONTH(TODAY())),Shipping_PO!$E$2:$E$65536)
  38.                            
  39.         .Range("M2:M" & R) = "=RC[-1]*RC[-7]"                        '=L2*F2"
  40.             
  41.         .Range("N2:N" & R) = "=RC[-1]*29.5"                         '=M2*29.5
  42.             
  43.         .Range("O2:O" & R) = "=RC[-9]*RC[-5]"                       '=F2*J2
  44.             
  45.         .Range("P2:P" & R) = "=RC[-1]*29.5"                        '=O3*29.5
  46.         .UsedRange.Value = .UsedRange.Value
  47.         .Parent.Save
  48.     End With
  49. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 5# nifanliu
Q1  R = [a1].End(xlDown).End(xlDown).End(xlUp).Row 多一個End(xlDown)).End(xlUp) ,其實是多餘的.@@@@

Q2 改變 F,G欄數值格式
  1.    R = .[a1].End(xlDown).Row
  2.         If R = 1 Then R = 2
  3.          .Range("F2:G" & R).NumberFormatLocal = "G/通用格式"   '設為通用格式
  4.        '...程式碼 略過....
  5.          '...程式碼 略過....
  6.          .Range("P2:P" & R) = "=RC[-1]*29.5"                        '=O3*29.5
  7.         .UsedRange.Value = .UsedRange.Value
  8.         .Range("F2:G" & R).NumberFormatLocal = "_-$* #,##0.00000_-;-$* #,##0.00000_-;_-$* ""-""?????_-;_-@_-"
  9.                              '改回會計 格式
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 信心、毅力、勇氣三者具備,則天下沒有做不成的事。
返回列表 上一主題