返回列表 上一主題 發帖

[發問] 不同的sheet相同的動作,如何讓它一次性完成?

[發問] 不同的sheet相同的動作,如何讓它一次性完成?

大家好,
每個sheet相同的動作,如何讓它一次性完成?
動作1: AA:AL      COPY後原範圍貼上值(就是將公式去除)
動作2: A:AD 取消自動篩選,再恢愎自動篩選(因為是公用表格,這樣做可以讓不當操作時,使自動篩選正常)
動作3: 排序>>>順序為AC,U,Q,C,D

巨集儲存在: VBA Cluster.xlsm
需要做重複動作的檔案是: 2012 samples Chart

2012 samples Chart.zip (131.55 KB)

回復 2# oobird
您好,

能不能教我用陣列方式的寫法?這樣以後若資料有變動修改會更方便!

謝謝您.

TOP

回復 4# oobird
類似像以下這樣的,我感覺很不錯,請你幫我看看是不是可行?
  1. Sub Acopy_from_Multi_format()
  2.     Dim Wb(1 To 2) As Workbook, xS As Integer, Ar1(), Ar2()
  3.     '*** 指定給變數: 如程序很大 修改名稱時不必在程序中一一更改 ***
  4.     Dim Ar(1 To 2)
  5.     Set Wb(1) = Workbooks("2011 BCMart Multi-Format.xlsx")
  6.     Set Wb(2) = Workbooks("VBA Cluster.xlsm")
  7.     Ar1 = Array("BCM控管", "Factory ship", "Chart", "HD")    '置入陣列
  8.     Ar2 = Array("A:EK", "A:AP", "A:AQ", "A:AO")                '置入陣列
  9.     For xS = 0 To UBound(Ar1)     '-> Array("BCM控管", "Factory xsip", "Chart")
  10.         With Wb(1).Sheets(Ar1(xS))                                  '代入 Ar1(xS)
  11.             .Columns("A:EK").Hidden = False
  12.             Intersect(.UsedRange, .Range(Ar2(xS))).SpecialCells(xlCellTypeVisible).Copy
  13.                                    ''代入 Ar2(xS) : 先做複製的動作
  14.                 With Wb(2).Sheets(Ar1(xS))                              '代入 Ar1(xS)
  15.                     .Range("A1").PasteSpecial Paste:=xlPasteAll         '完全複製
  16.                     .Range("A1").PasteSpecial Paste:=xlPasteValues      '複製值
  17.                     .Columns("A:EK").Hidden = False
  18.             End With
  19.         End With
  20.     Next
  21.     Application.CutCopyMode = False
  22. End Sub
複製代碼

TOP

回復 6# oobird
Hi,
目前我附上的檔案有 Apr, May, Jun, Jul, Aug, Sep, Oct 等Sheets(以後都還會增加)
    Ar1 = Array(Apr, May, Jun, Jul, Aug, Sep, Oct)    '置入陣列 (或許也能這樣寫...Apr之後的Sheets都作相同動作)
    Ar2 = Array(動作1: AA4:AL有資料的最後一列,COPY後原範圍貼上值    動作2: A4:AD4 取消自動篩選,再恢愎自動篩選   動作3: 排序順序為AC,U,Q,C,D)                '置入陣列
能不能用上述的類似作法? 不好意思,我無法將敍述轉成程式,不過我想以上的構思應該是能夠實現的,只有動作1: AA4:AL有資料的最後一列,COPY後原範圍貼上值,可能比較有問題,不知能否用程式去達成?
因為AD:AE是完全空白欄,而AC的最後一列資料與AF的表格又有3行以上的完全空白列.

TOP

回復 6# oobird
補充:這是我天馬行空的想法,若是有悖於正常程式的寫法,請勿見怪!
另外....真的寫得成的話,也請給我完整的程式,因為..你知道的,我不會拼湊太複雜的程式.
感謝您!

TOP

回復 10# GBKEE

你的建議很不錯,謝謝.

TOP

回復 9# oobird
超級版主您好,

我的巨集程式與須執行巨集的工作表分開,所以我在For 的前一行加了   Workbooks("2012 samples Chart.xlsx").Activate這樣執行就ok了,
以下問題想請教您:
1) 我每年的工作表是依月份為sheet名稱,現在是5月,若我想讓1~4月不要執行前面的巨集程式,是否可以將程式稍加修改為:
指定Sheet "May"之後的工作表再執行前述的巨集?我應該怎麼改?可否寫出完整的程式?(這個寫法請用指定的sheet名稱,不能用程式去判別現在的月份,因為我們的工作表要等結帳完畢,才不會用到上述的巨集)
2)         n = sh.[AC1000].End(3).Row 'ac欄最後儲存格列號...End後面的(3)代表什麼?

TOP

回復 13# oobird
oobird:
程式執行至    If InStr("MayJunJulAugSepOctNovDec", sh.May) Then '從"May"開始作業一直到最後一個工作表
出現問題就執行不下去了,所以沒有執行完,請幫忙看看有什麼問題?
  1.    Workbooks("2012 samples Chart.xlsx").Activate
  2.     For Each sh In Sheets '在所有工作表中循環
  3.     If InStr("MayJunJulAugSepOctNovDec", sh.May) Then '從"May"開始作業一直到最後一個工作表
  4.     sh.Activate    '執行程式
  5.     End If
  6.     'Next
  7.    
  8.         sh.UsedRange = sh.UsedRange.Value '把公式結果變成值
  9.         'sh.[a4:ad4].AutoFilter '取消自動篩選
  10.         'sh.[a4:ad4].AutoFilter '建立自動篩
  11.         sh.AutoFilterMode = False '取消自動篩選
  12.         sh.[a4:ad4].AutoFilter '建立自動篩
  13.         
  14.         n = sh.[AC1000].End(3).Row 'ac欄最後儲存格列號
  15.         sh.Sort.SortFields.Clear '清除重建排序條件
  16.         ar = Array("ac", "u", "q", "c", "d")
  17.         For i = 0 To UBound(ar)
  18.             sh.Sort.SortFields.Add Key:=sh.Range(ar(i) & "5:" & ar(i) & n)
  19.         Next
  20.         With sh.Sort '對指定範圍以指定條件排序
  21.             .SetRange sh.Range("A5:AD" & n)
  22.             .Header = xlNo
  23.             .MatchCase = False
  24.             .Orientation = xlTopToBottom
  25.             .SortMethod = xlPinYin
  26.             .Apply
  27.         End With
  28.     Next '下一個工作表
  29.     End Sub
複製代碼

TOP

回復 16# GBKEE
G大,

我的工作表不能以程式去指定月份(例:    For xi = Month(Date) To Sheets.Count ),因為有結帳的問題,待結帳完才能不執行巨集,所以無法用這個語法.

TOP

回復 17# oobird
Hi oobird,
執行ok.
請教語法問題:
1) 以下替換為你所寫的另一語法(如下表):
For i = 5 To 12 (我使用的sample因為1~3月份已刪除,所以我將之改為2~7)
Sheets(i).Activate '執行工作
Next
但無法執行,是否我把哪裡給改錯了?
2) 另一語法        If InStr("MayJunJulAugSepOctNovDec", sh.Name) Then
我看到上述2個語法都是要將每一毎工作表寫出來,我想知道有沒有"指定式"的?(例:從sheet(May)開始至最後一個工作表,而不用將May之後的每個工作表都列出?
  1.    Workbooks("2012 samples Chart.xlsx").Activate
  2.         For i = 2 To 7  '從2nd的工作表執行至7st
  3.          Sheets(i).Activate '執行工作
  4.             sh.UsedRange = sh.UsedRange.Value    '把公式結果變成值
  5.             sh.AutoFilterMode = False     '取消自動篩選
  6.             sh.[a4:ad4].AutoFilter    '建立自動篩

  7.             n = sh.[AC1000].End(3).Row    'ac欄最後儲存格列號
  8.             sh.Sort.SortFields.Clear    '清除重建排序條件
  9.             ar = Array("ac", "u", "q", "c", "d")
  10.             For i = 0 To UBound(ar)
  11.                 sh.Sort.SortFields.Add Key:=sh.Range(ar(i) & "5:" & ar(i) & n)
  12.             Next
  13.             With sh.Sort    '對指定範圍以指定條件排序
  14.                 .SetRange sh.Range("A5:AD" & n)
  15.                 .Header = xlNo
  16.                 .MatchCase = False
  17.                 .Orientation = xlTopToBottom
  18.                 .SortMethod = xlPinYin
  19.                 .Apply
  20.             End With
  21.         End If
  22.     Next    '下一個工作表
  23. End Sub
複製代碼

TOP

        靜思自在 : 唯其尊重自己的人,才更勇於縮小自己。
返回列表 上一主題