返回列表 上一主題 發帖

程式如何寫比較順暢快速

程式如何寫比較順暢快速

各位前輩你們好!
         前輩!!問題如附檔說明
         請知道的前輩,不吝賜教謝謝再三!!
Sub 練習()
    With Sheets("練習")
      [AG3] = "=AB2-SUM(AD2/2,AE2,AA3,AC3/2)": [AI3] = "=AG3/(AA3+AC3/2)"
      .Range("V" & Rows.Count).End(xlUp)(2, 1).Select: Selection = Date: ActiveCell.Offset(0, 1).Select
      ZZ = Application.InputBox("請輸入數字", "練習資料", Type:=1)
      If ZZ <= 0 Then ActiveCell.Offset(0, -1) = "": [AG3,AI3] = "": End
      ActiveCell = ZZ: ActiveCell.Font.ColorIndex = 7: ActiveCell.Offset(0, 1).Select
ag:
      ZZ = Application.InputBox("請輸入數字", "數據資料", Type:=1)
      If ZZ <= 0 Then GoTo ag
      ActiveCell = ZZ: ActiveCell.Offset(0, 2).Select
      [Z3:AI3].Copy: ActiveSheet.Paste: Calculate: [AG3,AI3] = "": Application.CutCopyMode = False
      ActiveCell.Offset(, 2) = "": ActiveCell.Offset(, 4) = "": ActiveCell.Offset(, 5) = "": ActiveCell.Offset(, 8) = ""
      .Range("AC" & Rows.Count).End(xlUp).Select
      If Selection <= 150 Then Selection = 200: ActiveCell.Font.ColorIndex = 7
      .Range("AG" & Rows.Count).End(xlUp).Select: ActiveCell.Font.ColorIndex = 10
      .Range("AI" & Rows.Count).End(xlUp).Select
      If Selection < 0 Then ActiveCell.Font.ColorIndex = 3
: Calculate: .Columns("V:AI").EntireColumn.AutoFit
      End With
      ActiveWorkbook.Save
End Sub

LeoV66.rar (10.87 KB)

回復 1# myleoyes
試試看
  1. Sub 練習()
  2.     Dim Rng As Range
  3.     With Sheets("練習")
  4.         .[AG3] = "=AB2-SUM(AD2/2,AE2,AA3,AC3/2)": .[AI3] = "=AG3/(AA3+AC3/2)"
  5.         Set Rng = Sheets("練習").Range("V" & Rows.Count).End(xlUp)(2, 1)
  6.         Rng = Date
  7.         ZZ = Application.InputBox("請輸入數字", "練習資料", Type:=1)
  8.         If ZZ <= 0 Then Rng = "": .[AG3,AI3] = "": End
  9.         With Rng.Cells(1, 2)    '由Rng的欄位算起第2欄同一列的儲存格 = W欄
  10.             .Value = ZZ
  11.             .Font.ColorIndex = 7
  12.         End With
  13. ag:
  14.         ZZ = Application.InputBox("請輸入數字", "數據資料", Type:=1)
  15.         If ZZ <= 0 Then GoTo ag
  16.         With Rng.Cells(1, 3)   '由Rng的欄位算起第3欄同一列的儲存格=X欄
  17.             .Value = ZZ
  18.             .Font.ColorIndex = 7
  19.         End With
  20.         With Rng.Cells(1, 5)    '由Rng的欄位算起第4欄同一列的儲存格=Z欄
  21.             For Each e In Array(1, 2, 4, 8, 10) '陣列: 由Z欄算起的欄
  22.                 With .Cells(1, e)               '由Z欄算起的欄同一列的儲存格
  23.                     .FormulaR1C1 = Cells(3, .Column).FormulaR1C1
  24.                     If e = 4 And .Value <= 150 Then
  25.                         .Value = 200
  26.                         .Font.ColorIndex = 7
  27.                     ElseIf e = 8 Then
  28.                         .Font.ColorIndex = 10
  29.                     ElseIf e = 10 And .Value < 0 Then
  30.                         .Font.ColorIndex = 3
  31.                     End If
  32.                 End With
  33.             Next
  34.         End With
  35.         .Columns("V:AI").EntireColumn.AutoFit
  36.         '如活頁簿設定計算 :方式為手動,那才須重算此工作表.
  37.        .Calculate  '重算此工作表.
  38.        '此重算 也許是你認為執行起來覺得很慢 的主因
  39.      End With
  40.      ActiveWorkbook.Save
  41. End Sub
複製代碼

TOP

回復 2# GBKEE
良師!謝謝!程式OK! 下個範例再麻煩一下
      當儲存格解註內容的最後兩個字是配股
        程式就會改變儲存格的顏色
        例如D3解註=聯詠配股變顏色
                D4解註=聯詠配息不會變顏色
                D5解註=台積電配股也變顏色
        如何修改此程式才能合乎需求
Sub 股利所得()
Again:
    ZZ = Application.InputBox("輸入金額", "請輸入股利收入", "10,000", Type:=1)
    [A15] = ZZ
    If ZZ > 10000000 Then [A15] = 10000000
    If [A15] = False Then [A15] = "": End
    If ZZ <= 5000 Then MsgBox "股利收入少於或等於5000不扣補充保費!!": [A15] = "": GoTo Again
    [A15] = [A14] * [A15]
    With Sheets("應扣額")
      .[A15].Copy .[D100].End(xlUp)(2, 1)
      .[D15:D100].Font.ColorIndex = 7
      .Range("D" & Rows.Count).End(xlUp).Select
      If ActiveCell.Comment Is Nothing Then ActiveCell.AddComment
       ZZ = InputBox("請輸入股票名稱與配息或配股", "解註", " 配息 或配股", 0)
    If ZZ = "" Then ActiveCell.Comment.Delete: Exit Sub
       ActiveCell.Comment.Text Text:=ZZ
      If ActiveCell.Comment.Text = "配股" Then ActiveCell.Font.ColorIndex = 5
      [A15] = "": [D15].Select
    End With
End Sub
     良師!請再辛苦囉!謝謝再三!!

TOP

回復 3# myleoyes
  1. If ActiveCell.Comment.Text Like "*配股*" Then ActiveCell.Font.ColorIndex = 5
複製代碼

TOP

回復 4# GBKEE
良師!謝謝!程式OK!不好意思這個範例再麻煩一下
Sub Ex()
            Selection = CDate(Application.Ceiling((DateSerial(Year(Date), 1, 1) - 7) / 7, 1) * 7 + 7
* 3)
            Selection.Offset(0, 1) = "=IF(ISNUMBER(MATCH(A1,EDATE(A22,{0,6,12})-(WEEKDAY(EDATE(A22,
{0,6,12}),2)-6),0)),""維修""&LOOKUP(A1,EDATE(A22,{0,6,12})-(WEEKDAY(EDATE(A22,{0,6,12}),2)-6),
{1,2,0})&""次"",INDEX(EDATE(A22,{12,6,0})-(WEEKDAY(EDATE(A22,{12,6,0}),2)-6),MATCH(A1,EDATE(A22,
{12,6,0})-(WEEKDAY(EDATE(A22,{12,6,0}),2)-6),-1)))"
           End Sub
        當點選A22時,程式在B22寫入=IF(ISNUMBER(MATCH(A1,EDATE(A22,{0,6,12})-....,-1)))公式
        但問題是當點選A25時,程式在B25寫入的還是"=IF(ISNUMBER(MATCH(A1,EDATE(A22,{0,6,12})-....,-
1)))"  公式
        也就是說 A22 並無法變成 A25
        不知有方式可以解決此難題
        請不吝賜教謝謝再三!!

TOP

回復 5# myleoyes
用R1C1 表示法
"=IF(ISNUMBER(MATCH(A1,EDATE(RC[-1],{0,6,12})-....,-"

TOP

回復 6# GBKEE
良師!謝謝!為何?按鈕會是錯誤訊息呢?   
       =IF(ISNUMBER(MATCH('A1',EDATE(A24,{0,6,12})...
       A1為何變成'A1'
      如附檔所示
     請再麻煩指導謝謝再三!!辛苦囉!

LeoV67.rar (8.69 KB)

TOP

回復 7# myleoyes
用R1C1 表示法"=IF(ISNUMBER(MATCH(A1,EDATE(RC[-1],{0,6,12})-....,-"

A1 沒改到
"=IF(ISNUMBER(MATCH(R1C1,EDATE(RC[-1],{0,6,12})-....,-"[/quote]

TOP

回復 7# myleoyes
回復 8# GBKEE
Sub 維修()與Sub Ex() 正如 GBKEE 大大之修正後的結果:
  1. Sub 維修()
  2.       Selection = CDate(Application.Ceiling((DateSerial(Year(Date), 1, 1) - 7) / 7, 1) * 7 + 7 * 3)
  3.       Selection.Offset(0, 1) = "=IF(ISNUMBER(MATCH(R1C1,EDATE(RC[-1],{0,6,12})-(WEEKDAY(EDATE(RC[-1],{0,6,12}),2)-6),0)),""維修""&LOOKUP(R1C1,EDATE(RC[-1],{0,6,12})-(WEEKDAY(EDATE(RC[-1],{0,6,12}),2)-6),{1,2,0})&""次"",INDEX(EDATE(RC[-1],{12,6,0})-(WEEKDAY(EDATE(RC[-1],{12,6,0}),2)-6),MATCH(R1C1,EDATE(RC[-1],{12,6,0})-(WEEKDAY(EDATE(RC[-1],{12,6,0}),2)-6),-1)))"
  4. End Sub

  5. Sub Ex()
  6.       Selection = CDate(Application.Ceiling((DateSerial(Year(Date), 1, 1) - 7) / 7, 1) * 7 + 7 * 3)
  7.       Selection.Offset(0, 1) = "=IF(ISNUMBER(MATCH(A1,EDATE(A22,{0,6,12})-(WEEKDAY(EDATE(A22,{0,6,12}),2)-6),0)),""維修""&LOOKUP(A1,EDATE(A22,{0,6,12})-(WEEKDAY(EDATE(A22,{0,6,12}),2)-6),{1,2,0})&""次"",INDEX(EDATE(A22,{12,6,0})-(WEEKDAY(EDATE(A22,{12,6,0}),2)-6),MATCH(A1,EDATE(A22,{12,6,0})-(WEEKDAY(EDATE(A22,{12,6,0}),2)-6),-1)))"
  8. End Sub
複製代碼

GBKEE 大大,到目前為止,我也瞭解了 FormulaR1C1 的應用,謝謝您!

TOP

回復 8# GBKEE
請教您為什麼Sub 維修()與Sub Ex()執行出來的結果值不一樣呢?
左邊完全是Sub Ex()執行出來的結果,右方則是兩者混合交錯執行。

TOP

        靜思自在 : 靜坐常恩己過、閒談莫論人非。
返回列表 上一主題