PJChen

　暱稱: PJ

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2012-4-30 22:36 | 只看該作者

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

樓主熱帖

oobird

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

2^#

發表於 2012-5-1 08:29 | 只看該作者

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

複製代碼

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

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

3^#

發表於 2012-5-3 23:21 | 只看該作者

回復 2# oobird
您好,

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

謝謝您.

TOP

oobird

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

4^#

發表於 2012-5-3 23:48 | 只看該作者

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

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

5^#

發表於 2012-5-4 01:40 | 只看該作者

回復 4# oobird
類似像以下這樣的,我感覺很不錯,請你幫我看看是不是可行?

Sub Acopy_from_Multi_format()
Dim Wb(1 To 2) As Workbook, xS As Integer, Ar1(), Ar2()
'*** 指定給變數: 如程序很大修改名稱時不必在程序中一一更改 ***
Dim Ar(1 To 2)
Set Wb(1) = Workbooks("2011 BCMart Multi-Format.xlsx")
Set Wb(2) = Workbooks("VBA Cluster.xlsm")
Ar1 = Array("BCM控管", "Factory ship", "Chart", "HD") '置入陣列
Ar2 = Array("A:EK", "A:AP", "A:AQ", "A:AO") '置入陣列
For xS = 0 To UBound(Ar1) '-> Array("BCM控管", "Factory xsip", "Chart")
With Wb(1).Sheets(Ar1(xS)) '代入 Ar1(xS)
.Columns("A:EK").Hidden = False
Intersect(.UsedRange, .Range(Ar2(xS))).SpecialCells(xlCellTypeVisible).Copy
''代入 Ar2(xS) : 先做複製的動作
With Wb(2).Sheets(Ar1(xS)) '代入 Ar1(xS)
.Range("A1").PasteSpecial Paste:=xlPasteAll '完全複製
.Range("A1").PasteSpecial Paste:=xlPasteValues '複製值
.Columns("A:EK").Hidden = False
End With
End With
Next
Application.CutCopyMode = False
End Sub

複製代碼

TOP

oobird

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

6^#

發表於 2012-5-4 09:00 | 只看該作者

此例中間段

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

複製代碼

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

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

複製代碼

是這個意思嗎？

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

7^#

發表於 2012-5-4 13:31 | 只看該作者

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

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

8^#

發表於 2012-5-4 13:36 | 只看該作者

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

TOP

oobird

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

9^#

發表於 2012-5-4 14:19 | 只看該作者

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

TOP

GBKEE