Board logo

標題: [發問] 不同的Sheet執行重覆的巨集 [打印本頁]

作者: PJChen    時間: 2011-10-16 21:19     標題: 不同的Sheet執行重覆的巨集

各位先進好,
我在Excel工作表中每次有新訂單就會增加一個新的月份的Sheet,並以訂單所屬的月份為Sheet命名,例如現在是10月則命名為"Oct",11月份的訂單就另開一個Sheet,命名為"Nov"....,以此類推,而且工作表中的格式都相同,以下巨集是我做的其中一個動作,因為總共有12個月份,我就要為copy所有的巨集,再修改"Sheets"的名稱.
工作表月份越大的我會放在右邊,也就是如同一般新增的Sheet一樣,會自動新增在右邊,有沒有一個巨集的寫法,可以讓Sheet在"Jan"右邊的,自動執行以下一模一樣的巨集,而不是將巨集copy 12次再改Sheet的名稱?
回覆時請以下列的巨集做修改,否則我不太會套用,謝謝!
    Sheets("Oct").Select
    Range("O20").Select
    ActiveCell.FormulaR1C1 = "=ROUND(RC10*RC12,2)"
    Range("O20").Select
   
    ActiveWorkbook.Save
作者: oobird    時間: 2011-10-16 21:37

你該把程式放在一般模組,不是工作表模組。
    Range("O20").Select
    ActiveCell.FormulaR1C1 = "=ROUND(RC10*RC12,2)"
      ActiveWorkbook.Save
這樣就行了,程式會作用在當前開啟的工作表
作者: PJChen    時間: 2011-10-16 22:31

不好意思,我不了解你說的"把程式放在一般模組,不是工作表模組"是什麼意思?
不過我照你寫給我的巨集去執行是無作用的,因為我的巨集指令是用錄的不是用寫的,裡面有很多指令,例如排序....,且是以其中一個月份為範本,其餘的照copy,只修改sheet名稱,例如我是以"Sep"去錄製,裡面會出現很多如Worksheets("Sep")的名稱,所以你完全不出現工作表名稱是無法執行巨集的.
作者: oobird    時間: 2011-10-16 22:59

所以你完全不出現工作表名稱是無法執行巨集的.

既然你這麼認為,就不知該如何幫你了。
作者: PJChen    時間: 2011-10-17 23:30

不知道是否還有其他方式,可以令右邊的多個sheet,執行同一個巨集?
作者: oobird    時間: 2011-10-18 20:31

本來巨集就只寫一個,每個工作表都可使用。
你一定要在巨集上冠工作表名就沒辦法了。
作者: GBKEE    時間: 2011-10-19 15:25

回復 1# PJChen
這樣可以嗎?
  1. Sub Ex() '工作表月份越大的我會放在右邊 -> 它的索引值 (Sheets.Count)
  2.     With Sheets(Sheets.Count)
  3.         .Range("O20").FormulaR1C1 = "=ROUND(RC10*RC12,2)"
  4.     Next
  5.     ActiveWorkbook.Save
  6. End Sub
  7. Sub Ex1() '可以讓Sheet在"Jan"右邊的,自動執行以下一模一樣的巨集 ->所有的工作表執行一模一樣的巨集
  8.     Dim Sh As Worksheet
  9.     For Each Sh In Sheets
  10.         Sh.Range("O20").FormulaR1C1 = "=ROUND(RC10*RC12,2)"
  11.     Next
  12.     ActiveWorkbook.Save
  13. End Sub
複製代碼
回復 3# PJChen
我不了解你說的"把程式放在一般模組,不是工作表模組
如圖:

[attach]8278[/attach]
作者: luhpro    時間: 2011-10-20 22:04

本帖最後由 luhpro 於 2011-10-20 22:08 編輯
不好意思,我不了解你說的"把程式放在一般模組,不是工作表模組"是什麼意思?
不過我照你寫給我的巨集去執行 ...
PJChen 發表於 2011-10-16 22:31

當你點擊任一現存工作表接著點選 "檢視程式碼" 後所看到的程式就是位於 "工作表模組" 內,
一般來說全新的 Excel 檔案內並不會自動產生 "一般模組",
當我們點擊了 "插入" 再點 "模組" 之後出現的 Module1 就是 "一般模組",
若再繼續新增 Module2 ... 等這些都是 "一般模組".

回復 1# PJChen
你的需求基本上還是可以做到的,
關鍵在於呼叫一般模組程序時要把標的Sheet傳遞給該模組程序以便其使用.
因為你的例子中都是針對 Range("O20") 做處理,
故而我們可以僅傳遞 Range("O20")  過去使用.
(一般模組)
  1. Sub SetData(rTarget As Range)
  2.   With rTarget
  3.     .FormulaR1C1 = "=ROUND(RC10*RC12,2)"
  4.     .Select
  5.     ActiveWorkbook.Save
  6.   End With
  7. End Sub
複製代碼
(各工作表模組) (假設要在 SelectionChange 內呼叫共用程序)
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.   Call SetData(Range("O20"))
  3. End Sub
複製代碼
[attach]8286[/attach]
(後記 : 程式上傳後才發現打字時誤Key SetData 為 SetDate 請自行修改程序名稱)
作者: PJChen    時間: 2011-10-22 00:24

感謝各位先進的回覆,
我使用的巨集都是用錄製的,所以各位寫給我的,我真的看不懂,不過我依"oobird"教我的方法,在巨集中不要冠上工作表的名稱,所以我將其中一個比較短的巨集先將所有工作表名稱去除後執行巨集,可是出現對話誆"編譯錯誤:找不到方法或資料成員"我不了解它的意思是什麼,不過有箭頭指著巨集的第一行,顯示有問題,由於我之前問的問題只是截取一小段巨集內容,而大家回覆給我的,我又不會套用,所以我將完整的巨集寫於下,希望樓上有回覆給我的各種方式都幫我套入完整的巨集中,我再遂一試試看結果如何?不是我偷懶,我真的看不懂.
Sub sorting_chart()
'
' sorting_chart 巨集
'

'
    Windows("2011 BCMart Chart.xls").Activate
   
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("U4").Select
    ActiveWorkbook.Worksheets.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets.Sort.SortFields.Add Key:=Range("U5:U3000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets.Sort.SortFields.Add Key:=Range("Q53000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets.Sort.SortFields.Add Key:=Range("A5:A3000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets.Sort
        .SetRange Range("A4:AA3000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.SaveAs Filename:= _
        ":\BCM\2011 BCMart Chart\2011 BCMart Chart-sorted-2011.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False

End Sub




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