Board logo

標題: [發問] 不同的sheet相同的動作,如何讓它一次性完成? [打印本頁]
作者: PJChen    時間: 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

[attach]10759[/attach]
作者: oobird    時間: 2012-5-1 08:29

  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)

  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    時間: 2012-5-3 23:21

回復 2# oobird
您好,

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

謝謝您.
作者: oobird    時間: 2012-5-3 23:48

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

回復 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    時間: 2012-5-4 09:00

此例中間段
  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    時間: 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行以上的完全空白列.
[attach]10804[/attach]
作者: PJChen    時間: 2012-5-4 13:36

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

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

回復 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  都會取消自動篩選
作者: PJChen    時間: 2012-5-4 23:41

回復 10# GBKEE

你的建議很不錯,謝謝.
作者: PJChen    時間: 2012-5-4 23:52

回復 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)代表什麼?
作者: oobird    時間: 2012-5-6 10:37

End後面的(3)~xlup,該欄有資料的最後一列
若妳的工作表按順序排列，可以指定從第幾個工作表開始。
如：For i = 5 To 12
Sheets(i).Activate
執行妳的工作
Next
或者以表名的文字判斷，例如：
For Each sh In Sheets
If InStr("MayJunJulAugSepOctNovDec", sh.Name) Then
sh.Activate
執行程式
End If
Next
作者: PJChen    時間: 2012-5-6 14:59

回復 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
複製代碼
作者: GBKEE    時間: 2012-5-6 15:23

本帖最後由 GBKEE 於 2012-5-6 17:36 編輯

回復 15# PJChen
If InStr("MayJunJulAugSepOctNovDec", sh.May) Then  sh 沒這 屬性
  1. Workbooks("2012 samples Chart.xlsx").Activate
  2.     For xi = Month(Date) To Sheets.Count                              'Month(Date) 當月份
  3.         Sheets(Format(DateSerial(2001, xi, 1), "Mmm")).Activate    '當月份工作表
  4.     Next
複製代碼
作者: oobird    時間: 2012-5-6 15:27

  1. Sub test()
  2.     Workbooks("2012 samples Chart.xlsx").Activate
  3.     For Each sh In Sheets    '在所有工作表中循環
  4.         If InStr("MayJunJulAugSepOctNovDec", sh.Name) Then    '從"May"開始作業一直到最後一個工作表
  5.             sh.Activate    '執行程式

  7.             sh.UsedRange = sh.UsedRange.Value    '把公式結果變成值
  8.             sh.AutoFilterMode = False     '取消自動篩選
  9.             sh.[a4:ad4].AutoFilter    '建立自動篩

  11.             n = sh.[AC1000].End(3).Row    'ac欄最後儲存格列號
  12.             sh.Sort.SortFields.Clear    '清除重建排序條件
  13.             ar = Array("ac", "u", "q", "c", "d")
  14.             For i = 0 To UBound(ar)
  15.                 sh.Sort.SortFields.Add Key:=sh.Range(ar(i) & "5:" & ar(i) & n)
  16.             Next
  17.             With sh.Sort    '對指定範圍以指定條件排序
  18.                 .SetRange sh.Range("A5:AD" & n)
  19.                 .Header = xlNo
  20.                 .MatchCase = False
  21.                 .Orientation = xlTopToBottom
  22.                 .SortMethod = xlPinYin
  23.                 .Apply
  24.             End With
  25.         End If
  26.     Next    '下一個工作表
  27. End Sub
複製代碼
注意這一行：
  If InStr("MayJunJulAugSepOctNovDec", sh.Name) Then
sh.Name是工作表名，如工作表May表名就是May
在"MayJunJulAugSepOctNovDec"這個字串中有包含May的話就執行
其他表也一樣類推
sh.May,是錯誤的表達。
作者: PJChen    時間: 2012-5-6 16:05

回復 16# GBKEE
G大,

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

回復 18# PJChen
  1. For xi = Month(Date) To 12        'Month(Date) 當月份  到 12月份
複製代碼
作者: PJChen    時間: 2012-5-6 16:31

回復 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    '建立自動篩

  8.             n = sh.[AC1000].End(3).Row    'ac欄最後儲存格列號
  9.             sh.Sort.SortFields.Clear    '清除重建排序條件
  10.             ar = Array("ac", "u", "q", "c", "d")
  11.             For i = 0 To UBound(ar)
  12.                 sh.Sort.SortFields.Add Key:=sh.Range(ar(i) & "5:" & ar(i) & n)
  13.             Next
  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.         End If
  23.     Next    '下一個工作表
  24. End Sub
複製代碼
作者: PJChen    時間: 2012-5-6 16:49

本帖最後由 GBKEE 於 2012-5-6 17:38 編輯

回復 19# GBKEE
G大,
請問你的意思是這樣嗎?可是無法執行,可以幫忙看一下嗎?
  1. Sub Try()

  3.     Workbooks("2012 samples Chart.xlsx").Activate
  4.     For Each sh In Sheets    '在所有工作表中循環
  5.     For xi = Month(Date) To 12        'Month(Date) 當月份  到 12月份
  6.     Sheets(Format(DateSerial(2001, xi, 1), "Mmm")).Activate    '當月份工作表

  8.         sh.UsedRange = sh.UsedRange.Value    '把公式結果變成值
  9.         sh.AutoFilterMode = False     '取消自動篩選
  10.         sh.[a4:ad4].AutoFilter    '建立自動篩

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

本帖最後由 GBKEE 於 2012-5-6 17:35 編輯

回復 21# PJChen
  1. Sub Try()
  2.     Dim sh As Worksheet, xi As Integer
  3.     Workbooks("2012 samples Chart.xlsx").Activate
  4.     '''  For Each sh In Sheets    '在所有工作表中循環
  5.     For xi = Month(Date) To 12        'Month(Date) 當月份  到 12月份
  6.      Set sh = Sheets(Format(DateSerial(2001, xi, 1), "Mmm"))
  7.         sh.Activate    '當月份工作
  8.         sh.UsedRange = sh.UsedRange.Value    '把公式結果變成值
  9.         sh.AutoFilterMode = False     '取消自動篩選
  10.         sh.[a4:ad4].AutoFilter    '建立自動篩
複製代碼
作者: PJChen    時間: 2012-5-6 17:14

本帖最後由 GBKEE 於 2012-5-6 17:39 編輯

回復 22# GBKEE
G大,
還是無法執行!請再幫忙看下!
  1. Sub Try()
  2.     Dim sh As Worksheet, xi As Integer
  3.     Workbooks("2012 samples Chart.xlsx").Activate
  4.      For xi = Month(Date) To 12        'Month(Date) 當月份  到 12月份
  5.      Set sh = Sheets(Format(DateSerial(2001, xi, 1), "Mmm"))
  6.         sh.Activate    '當月份工作
  7.         sh.UsedRange = sh.UsedRange.Value    '把公式結果變成值
  8.         sh.AutoFilterMode = False     '取消自動篩選
  9.         sh.[a4:ad4].AutoFilter    '建立自動篩
  10.         n = sh.[AC1000].End(3).Row    'ac欄最後儲存格列號
  11.         sh.Sort.SortFields.Clear    '清除重建排序條件
  12.         ar = Array("ac", "u", "q", "c", "d")
  13.         For i = 0 To UBound(ar)
  14.         sh.Sort.SortFields.Add Key:=sh.Range(ar(i) & "5:" & ar(i) & n)
  15.     Next
  16.         With sh.Sort  '對指定範圍以指定條件排序
  17.             .SetRange sh.Range("A5:AD" & n)
  18.             .Header = xlNo
  19.             .MatchCase = False
  20.             .Orientation = xlTopToBottom
  21.             .SortMethod = xlPinYin
  22.             .Apply
  23.         End With
  24.     Next    '下一個工作表
  25. End Sub
複製代碼
作者: GBKEE    時間: 2012-5-6 17:35

回復 23# PJChen
對不起:有點糊塗 請修改 一下
Set sh = Sheets(Format(DateSerial(2001, Month(xi), 1), "Mmm")) 錯誤
Set sh = Sheets(Format(DateSerial(2001, xi, 1), "Mmm"))  正確
作者: PJChen    時間: 2012-5-6 18:42

回復 24# GBKEE
G老大,
執行上有點小問題,不知是否能夠解決?
問題1 :現在的訂單只到10月份,我可以將它改為 For xi = Month(Date) To 10,但也有另一個問題,就是我前面一直在問的...指定Sheet Name開始的工作表再執行前述的巨集?原因是業務接單不見得一定按照月份,有可能其中一個月尚沒有訂單,比如現在接單至10月,有可能11月訂單未到,先接到12月份的,這樣執行上就會有問題!
問題2 :執行巨集過後現在打開Excel任一工作表(新的也相同)執行"copy"的動作時,不再像以前那樣會在儲存格有虛線閃動,而貼上之後也無法貼上公式,只貼上值,我從來未看過這種形,你是否知道原因為何?
作者: PJChen    時間: 2012-5-6 18:51

回復 24# GBKEE
G大,
問題2: ,我將Excel開開關關好多次, 現在已經沒有問題,只是不了解為何當時會有這種情形?可以幫我解惑嗎?
作者: PJChen    時間: 2012-5-6 20:18

回復 17# oobird
Hi oobird,
我又再次試了以下的語法,仍然無法執行,可否請你指導?
  1. Sub Try()
  2.    Workbooks("2012 samples Chart.xlsx").Activate
  3.         For i = 2 To 7  '從2nd的工作表執行至7st
  4.          Sheets(i).Activate '執行工作
  5.             sh.UsedRange = sh.UsedRange.Value    '把公式結果變成值
  6.             sh.AutoFilterMode = False     '取消自動篩選
  7.             sh.[a4:ad4].AutoFilter    '建立自動篩

  9.             n = sh.[AC1000].End(3).Row    'ac欄最後儲存格列號
  10.             sh.Sort.SortFields.Clear    '清除重建排序條件
  11.             ar = Array("ac", "u", "q", "c", "d")
  12.             For i = 0 To UBound(ar)
  13.                 sh.Sort.SortFields.Add Key:=sh.Range(ar(i) & "5:" & ar(i) & n)
  14.             Next
  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
複製代碼
作者: oobird    時間: 2012-5-6 21:43

第5行開始sh.UsedRange = sh.UsedRange.Value
這個叫sh的變數前面並沒有定義，突然冒出來程式就會中斷了。
可以這樣：
Workbooks("2012 samples Chart.xlsx").Activate
        For i = 2 To 7  '從2nd的工作表執行至7st
         Sheets(i).Activate '執行工作
set sh =activesheet
            sh.UsedRange = sh.UsedRange.Value  
以下不變
作者: PJChen    時間: 2012-5-6 21:55

回復 28# oobird
Hi,
巨集執行後指向這行有問題,Help!...  For i = 0 To UBound(ar)
  1. Sub Try()
  2.    Workbooks("2012 samples Chart.xlsx").Activate
  3.    For i = 2 To 7 '從2nd的工作表執行至7st
  4.    Sheets(i).Activate
  5.    Set sh = ActiveSheet
  6.             sh.UsedRange = sh.UsedRange.Value    '把公式結果變成值
  7.             sh.AutoFilterMode = False     '取消自動篩選
  8.             sh.[a4:ad4].AutoFilter    '建立自動篩

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

啊，剛剛沒注意，這裡兩個 i 在循環中重疊了
改掉其中一個：
For s = 2 To 7 '從2nd的工作表執行至7st
   Sheets(s).Activate
作者: PJChen    時間: 2012-5-6 22:07

回復 30# oobird

Bingo!!
太好了執行ok.
真謝謝你!
作者: PJChen    時間: 2012-5-9 13:13

回復 30# oobird
大師,
救命,我原先的需求是將動作1: AA:AL      的範圍變成值(就是將公式去除)
但我發現這個寫將整個工作表所有內容都變成值,而且變成值之後,原來格式都變成怪怪的日期格式.(如附件,蔩色底的標註),
[attach]10877[/attach]
以下巨集該如何修改成只將AA:AL有資料的範圍變成值?
  1.    Workbooks("2012 BCMart Chart.xlsx").Activate
  2.    For s = 5 To 10 '從第某個工作表執行至第某個
  3.    Sheets(s).Activate
  4.    Set Sh = ActiveSheet
  5.             Sh.UsedRange = Sh.UsedRange.Value    '把公式結果變成值
  6.             Sh.AutoFilterMode = False     '取消自動篩選
  7.             Sh.[a4:ad4].AutoFilter    '建立自動篩
  8.     Next    '下一個工作表
複製代碼
作者: oobird    時間: 2012-5-9 13:41

Sh.UsedRange = Sh.UsedRange.Value
改為
Sh.[aa:al] = Sh.[aa:al].Value
作者: PJChen    時間: 2012-5-9 14:31

回復 33# oobird
大師,
程式改成這樣是不會將其它的儲存格有公式的地方變成值,但也出現了可怕的"龜速",以前全部儲存格一起作業非常快速的,現在是一個個sheet.."龜速"作業,這點能夠改善嗎?  
作者: oobird    時間: 2012-5-9 14:53

  1. Workbooks("2012 samples Chart.xlsx").Activate
  2.    For s = 2 To 7 '從2nd的工作表執行至7st
  3.    Sheets(s).Activate
  4.    Set sh = ActiveSheet
  5.    n = sh.UsedRange.Rows.Count
  6.             sh.[aa5].Resize(n, 12) = sh.[aa5].Resize(n, 12).Value    '把公式結果變成值
  7.             sh.AutoFilterMode = False     '取消自動篩選
  8.             sh.[a4:ad4].AutoFilter    '建立自動篩
複製代碼
那改這樣吧，我沒用2010很難想像一百多萬列跑起來是什麼速度。
作者: PJChen    時間: 2012-5-9 17:10

回復 35# oobird
大師,
我試了一下,跟原來的一樣,會出現"填滿儲存格"的字樣,然後sheet.."龜速"作業,還有別的語法可以讓我再試試看嗎?拜託了.
作者: oobird    時間: 2012-5-9 19:57

應該 n = sh.UsedRange.Rows.Count (使用中的總列數)不會取過大的範圍
妳可以用f8鍵逐句運行，看看運行到這一行時n的值是否工作表的最後一列。
若不是就須要把底下的空白全部選中按delete清除
也可以改一下這句試試：
n=sh.[d10000].end(3).row (D欄有資料的最後列)
作者: PJChen    時間: 2012-5-10 09:12

回復 37# oobird
大師:

1)   n = sh.UsedRange.Rows.Count '(使用中的總列數)不會取過大的範圍....sheet..還是"龜速",而且,我需要的是AA:AL,這個語法只要將AA:AC變成值,因為AD:AE是空白列
2)   n=sh.[d10000].end(3).row (D欄有資料的最後列)....這個語無法執行
  1.    Workbooks("2012 BCMart Chart.xlsx").Activate
  2.    For s = 5 To 10 '從第某個工作表執行至第某個
  3.    Sheets(s).Activate
  4.    Set sh = ActiveSheet
  5.    n = sh.[d10000].End(3).Row '(D欄有資料的最後列)
  6.   'Sh.UsedRange = Sh.UsedRange.Value    '把有資料的儲存格,公式結果變成值
  7.             sh.[aa:al] = sh.[aa:al].Value  '把公式結果變成值
  8.             sh.AutoFilterMode = False     '取消自動篩選
  9.             sh.[a4:ad4].AutoFilter    '建立自動篩
  10.     Next    '下一個工作表
  11.     ActiveWorkbook.Save
複製代碼
作者: oobird    時間: 2012-5-10 11:18

本帖最後由 oobird 於 2012-5-10 11:22 編輯

妳沒有改到呀？我再整理一下：
Workbooks("2012 BCMart Chart.xlsx").Activate
   For s = 5 To 10 '從第某個工作表執行至第某個
   Sheets(s).Activate
   Set sh = ActiveSheet
   n = sh.[d10000].End(3).Row '(D欄有資料的最後列)這裡可以改成妳的資料中最齊的一欄
            sh.[aa5].Resize(n, 3) = sh.[aa5].Resize(n, 3).Value '把aa:ac變成值
            sh.AutoFilterMode = False     '取消自動篩選
            sh.[a4:ad4].AutoFilter    '建立自動篩
    Next    '下一個工作表
作者: PJChen    時間: 2012-5-10 14:15

回復 39# oobird

大師,
我改好並重新RUN一次了,跟其他的語法一樣,如果只是將AA:AL變成值的都跑得非常慢速,請問這樣是不是無解了?
作者: oobird    時間: 2012-5-10 14:36

AA:AL在2010中是數千萬個儲存格，所以會拉格
我沒考慮妳是用2010，所以輕率的給妳這個語法。
妳用後來的 n = sh.[d10000].End(3).Row
            sh.[aa5].Resize(n, 3) = sh.[aa5].Resize(n, 3).Value
就不會拉格啦！
作者: PJChen    時間: 2012-5-10 15:54

回復 41# oobird
Dear,
可是真的都跑得很慢,是原來的好幾倍時間呢!我也很不了解為什麼改為AA:AL會變成這樣?明明需要變成值的範圍變小了呀!
作者: Hsieh    時間: 2012-5-10 16:11

回復 42# PJChen
造成龜速有可能是公式重算結果
在城市開始先關閉自動重算
Application.Calculation = xlCalculationManual
到程序退出前再開啟自動重算
Application.Calculation = xlCalculationAutomatic
作者: PJChen    時間: 2012-5-10 16:21

回復 43# Hsieh
版大,
按您說的是否改成以下這樣,結果還是相同,我用碼表計時,每RUN一個工作表約17~20秒,這是指第一段程式,第二段程式則是舜間就完成了,或者可否請有興趣的人都幫忙看一下,這二段段程式有沒有什麼差別?還可以怎麼改?
真對不起啦!我看到這個速度簡直...
  1. Sub Try_2()
  2.    Workbooks("2012 BCMart Chart.xlsx").Activate
  3.    Application.Calculation = xlCalculationManual
  4.    For s = 5 To 10 '從第某個工作表執行至第某個
  5.    Sheets(s).Activate
  6.    Set sh = ActiveSheet
  7.    n = sh.[al10000].End(3).Row '(AL欄有資料的最後列)這裡可以改成妳的資料中最齊的一欄
  8.             sh.[aa:al] = sh.[aa:al].Value  '把公式結果變成值
  9.             sh.AutoFilterMode = False     '取消自動篩選
  10.             sh.[a4:ad4].AutoFilter    '建立自動篩
  11.     Next    '下一個工作表
  12.     Application.Calculation = xlCalculationManual
  13.     ActiveWorkbook.Save

  15.     Workbooks("2012 BCMart Chart.xlsx").Activate
  16.    For s = 5 To 10 '從第某個工作表執行至第某個
  17.    Sheets(s).Activate
  18.    Set sh = ActiveSheet
  19.             n = sh.[AC1000].End(3).Row    'ac欄最後儲存格列號
  20.             sh.Sort.SortFields.Clear    '清除重建排序條件
  21.             Ar = Array("ac", "u", "r", "s", "t", "q", "c", "d")
  22.             For i = 0 To UBound(Ar)
  23.                 sh.Sort.SortFields.Add Key:=sh.Range(Ar(i) & "5:" & Ar(i) & n)
  24.             Next
  25.             With sh.Sort    '對指定範圍以指定條件排序
  26.                 .SetRange sh.Range("A5:AD" & n)
  27.                 .Header = xlNo
  28.                 .MatchCase = False
  29.                 .Orientation = xlTopToBottom
  30.                 .SortMethod = xlPinYin
  31.                 .Apply
  32.             End With
  33.     Next    '下一個工作表
  34.     ActiveWorkbook.SaveAs "P:\BCMart Chart\2012 BCMart Chart-sorted.xlsx"
  35.    
  36. End Sub
複製代碼
作者: oobird    時間: 2012-5-10 22:59

Sub Try_2()
   Workbooks("2012 BCMart Chart.xlsx").Activate
   Application.Calculation = xlCalculationManual
   For s = 5 To 10 '從第某個工作表執行至第某個
   Sheets(s).Activate
   Set sh = ActiveSheet
   n = sh.[al10000].End(3).Row '(AL欄有資料的最後列)這裡可以改成妳的資料中最齊的一欄
            sh.[aa5].Resize(n, 12) = sh.[aa5].Resize(n, 12).Value  '把公式結果變成值
            sh.AutoFilterMode = False     '取消自動篩選
            sh.[a4:ad4].AutoFilter    '建立自動篩
    Next    '下一個工作表
    Application.Calculation = xlCalculationManual
    ActiveWorkbook.Save
作者: PJChen    時間: 2012-5-11 11:12

回復 45# oobird
回復 43# Hsieh
報告 二位版主,
經過昨天oobird版主的提點,現在程式執行速度完全正常,感謝多日來不辭辛勞幫我解決問題.



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