返回列表 上一主題 發帖

[發問] 不同的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)

  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.         With sh.Sort '對指定範圍以指定條件排序
  15.             .SetRange sh.Range("A5:AD" & n)
  16.             .Header = xlNo
  17.             .MatchCase = False
  18.             .Orientation = xlTopToBottom
  19.             .SortMethod = xlPinYin
  20.             .Apply
  21.         End With
  22.     Next '下一個工作表
  23. End Sub
複製代碼
日期欄位日期格式不正確會影響排序正確性

TOP

回復 2# oobird
您好,

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

謝謝您.

TOP

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

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

此例中間段
  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
複製代碼
是這個意思嗎?

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行以上的完全空白列.
ex.jpg
2012-5-4 13:29

TOP

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

TOP

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

TOP

回復 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  都會取消自動篩選
1

評分人數

    • oobird: 細心+熱心!可敬的精神金錢 + 2

TOP

        靜思自在 : 【時日莫空過】一個人在世間做了多少事,就等於壽命有多長。因此必須與時間競爭,切莫使時日空過。
返回列表 上一主題