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

PJChen

大家好,
每個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)

下載次數: 28

2012-4-30 22:35

oobird

1. Sub yy()
   
2.     For Each sh In Sheets '在所有工作表中循環
   
3.         sh.UsedRange = sh.UsedRange.Value '把公式結果變成值
   
4.         sh.[a4:ad4].AutoFilter '取消自動篩選
   
5.         sh.[a4:ad4].AutoFilter '建立自動篩
   
6.         
   
7.         n = sh.[AC1000].End(3).Row 'ac欄最後儲存格列號
   
8.         sh.Sort.SortFields.Clear '清除重建排序條件
   
9.         sh.Sort.SortFields.Add Key:=sh.Range("AC5:AC" & n)
   
10.         sh.Sort.SortFields.Add Key:=sh.Range("u5:u" & n)
    
11.         sh.Sort.SortFields.Add Key:=sh.Range("q5:q" & n)
    
12.         sh.Sort.SortFields.Add Key:=sh.Range("c5:c" & n)
    
13.         sh.Sort.SortFields.Add Key:=sh.Range("d5:d" & n)
    
14. 
    
15.         With sh.Sort '對指定範圍以指定條件排序
    
16.             .SetRange sh.Range("A5:AD" & n)
    
17.             .Header = xlNo
    
18.             .MatchCase = False
    
19.             .Orientation = xlTopToBottom
    
20.             .SortMethod = xlPinYin
    
21.             .Apply
    
22.         End With
    
23.     Next '下一個工作表
    
24. End Sub

複製代碼

日期欄位日期格式不正確會影響排序正確性

PJChen

回復 2# oobird
您好,

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

謝謝您.

oobird

用陣列方式的寫法?~是指排序嗎？
排序還是用工作表自有的排序方式效率高得多
用陣列或遞迴排序代碼都會寫得很長很複雜，而且慢。
倒是這裡排序的條件可以用循環來減少代碼量，若熟悉循環及相關變數就不用一行行的寫了。

PJChen

回復 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

複製代碼

oobird

此例中間段

1. sh.Sort.SortFields.Add Key:=sh.Range("AC5:AC" & n)
   
2.         sh.Sort.SortFields.Add Key:=sh.Range("u5:u" & n)
   
3.         sh.Sort.SortFields.Add Key:=sh.Range("q5:q" & n)
   
4.         sh.Sort.SortFields.Add Key:=sh.Range("c5:c" & n)
   
5.         sh.Sort.SortFields.Add Key:=sh.Range("d5:d" & n)

複製代碼

可以把欄名放在陣列中循環

1. ar = Array("ac", "u", "q", "c", "d")
   
2.         For i = 0 To UBound(ar)
   
3.             sh.Sort.SortFields.Add Key:=sh.Range(ar(i) & "5:" & ar(i) & n)
   
4.         Next

複製代碼

是這個意思嗎？

PJChen

回復 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行以上的完全空白列.

下載 (80.67 KB)

2012-5-4 13:29

PJChen

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

oobird

二樓的前兩行不就是這個要求？
For Each sh In Sheets '在所有工作表中循環
        sh.UsedRange = sh.UsedRange.Value '把公式結果變成值
不必一定要copy再以值貼上才能把公式變成值的。
在所有表中循環不須建立陣列，建立了也是多一道程序，又何必多此一舉？

GBKEE

回復 2# oobird

1. SH.[a4:ad4].AutoFilter '取消自動篩選
   
2. SH.[a4:ad4].AutoFilter '建立自動篩

複製代碼

這是後輩我的見解 ,如有錯誤請見諒.
程式開始執行初時         [a4:ad4] 是在自動篩選的狀態下,第一次的AutoFilter  才會是  取消自動篩選
但如   [a4:ad4] 不是在自動篩選的狀態下,第二次的AutoFilter 會是   取消自動篩選

1. SH.AutoFilterMode = False '取消自動篩選  
   
2.         SH.[a4:ad4].AutoFilter '建立自動篩
   
3.         

複製代碼

程式執行時   不管[a4:ad4] 是否在自動篩選的狀態下, AutoFilterMode = False  都會取消自動篩選