12
返回列表 上一主題 發帖

[分享] 優化巨大的VBA

play9091

帖子
87 
主題
24 
精華
0 
積分
122 
點名
0  
作業系統
win 7 
軟體版本
2016 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-1-16 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2011-7-20 21:25 | 只看該作者

[分享] 優化巨大的VBA

本帖最後由 play9091 於 2011-7-21 09:43 編輯

小弟寫了一個VBA來解決，每天要做三小時報告的囧境……花了二天的時間把它弄完了，但是它非常的巨大，而小弟功力尚淺，找不到優化的手斷，想請益一下版上的先進們幫助一下！！！
  1. Sub name_test()
  2.     Application.ScreenUpdating = False
  3.     Application.DisplayAlerts = False
  4.     T = Time
  5.     For I = 4 To 10
  6. '叫出KPI報告
  7.     KPI = InputBox("C#KPI報告路俓(順序從C4～C9，最後才是C1)")
  8.     Workbooks.Open (KPI)
  9.     Set KPI = Nothing
  10.     KPI = ActiveWorkbook.Name
  11. '叫出每日C#報告
  12.     Clu = InputBox("C#報告路俓(順序從C4～C9，最後才是C1)")
  13.     Workbooks.Open (Clu)
  14.     Set Clu = Nothing
  15.     Clu = ActiveWorkbook.Name
  16. '複制每日C#報告的sheet到KPI報告
  17.     If I <> 10 Then
  18.     Workbooks(Clu).Sheets("sheet1").Copy After:=Workbooks(KPI).Sheets("M2000 BSC KPI Report (2)")
  19.     Sheets("sheet1").Name = "C" & I
  20.     ElseIf I = 10 Then
  21.     Workbooks(Clu).Sheets("sheet1").Copy After:=Workbooks(KPI).Sheets("sheet5")
  22.     Sheets("Sheet1 (2)").Name = "C" & I
  23.     End If
  24.     Workbooks(Clu).Close SaveChanges:=False
  25.     Set Clu = Nothing
  26. '叫出paging報告
  27.     Pag = InputBox("paging報告路俓")
  28.     Workbooks.Open (Pag)
  29.     Set Pag = Nothing
  30.     Pag = ActiveWorkbook.Name
  31. '複制paging報告的sheet到KPI報告
  32.     If I <> 10 Then
  33.     Workbooks(Pag).Sheets("sheet1").Copy After:=Workbooks(KPI).Sheets("M2000 BSC KPI Report (2)")
  34.     Sheets("sheet1").Name = "paging"
  35.     ElseIf I = 10 Then
  36.     Workbooks(Pag).Sheets("sheet1").Copy After:=Workbooks(KPI).Sheets("sheet2")
  37.     Sheets("Sheet1 (2)").Name = "paging"
  38.     End If
  39.     Workbooks(Pag).Close SaveChanges:=False
  40.     Set Pag = Nothing
  41. '開始出報告
  42.     Sheets("paging").Select
  43.     Range("A11").Select
  44.     Range(Selection, Selection.End(xlToRight)).Select
  45.     Range(Selection, Selection.End(xlDown)).Select
  46.     Selection.Copy
  47.     If I <> 10 Then
  48.     Sheets("M2000 MSC Paging").Select
  49.     ElseIf I = 10 Then
  50.     Sheets("sheet5").Select
  51.     End If
  52.     Range("A2").Select
  53.     Range(Selection, Selection.End(xlToRight)).Select
  54.     Range(Selection, Selection.End(xlDown)).Select
  55.     ActiveSheet.Paste
  56. '清除剪貼薄
  57. '    My.Computer.Clipboard.Clear() = True
  58.     Sheets("C" & I).Select
  59.     Range("A11").Select
  60.     Range(Selection, Selection.End(xlToRight)).Select
  61.     Range(Selection, Selection.End(xlDown)).Select
  62.     Application.CutCopyMode = False
  63.     Selection.Copy
  64.     If I <> 10 Then
  65.     Sheets("M2000 BSC KPI Report").Select
  66.     Range("A3").Select
  67.     ElseIf I = 10 Then
  68.     Sheets("sheet2").Select
  69.     Range("A2").Select
  70.     End If
  71.     Range(Selection, Selection.End(xlToRight)).Select
  72.     Range(Selection, Selection.End(xlDown)).Select
  73.     ActiveSheet.Paste
  74.     If I <> 10 Then
  75. '清除剪貼薄
  76. '    My.Computer.Clipboard.Clear() = True
  77.     Sheets("C" & I).Select
  78.     Application.CutCopyMode = False
  79.     Sheets("C" & I).Range("E3").Value = "=IF(ISLOGICAL(E4)," & "" & ",A10)"
  80.     Sheets("C" & I).Range("F3").Value = "=IF(ISLOGICAL(F4)," & "" & ",A10)"
  81.     Sheets("C" & I).Range("E4").Value = "=Text(Right(A11, 8), ""hh:mm:ss"") >= ""02:00:00"""
  82.     Sheets("C" & I).Range("F4").Value = "=Text(Right(A11, 8), ""hh:mm:ss"") <= ""21:30:00"""
  83.     Range("A11").Select
  84.     Range(Selection, Selection.End(xlToRight)).Select
  85.     Range(Selection, Selection.End(xlDown)).Select
  86.     Range("A10:EQ5482").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
  87.         Range("E3:F4"), Unique:=False
  88.     Selection.Copy
  89.     Sheets("M2000 BSC KPI Report (2)").Select
  90.     Range("A3").Select
  91.     Range(Selection, Selection.End(xlToRight)).Select
  92.     Range(Selection, Selection.End(xlDown)).Select
  93.     ActiveSheet.Paste
  94.     End If
  95.     Sheets("C" & I).Delete
  96.     Sheets("paging").Delete
  97.     D = InputBox("輸入今天的日期(EX：16)")
  98.     If I <> 10 Then
  99.     Sheets("sheet2").Select
  100.     ElseIf I = 10 Then
  101.     Sheets("BSC23-43 BTS Track").Select
  102.     End If
  103.     Cells.Replace What:=D - 1, Replacement:=D, LookAt:=xlPart, SearchOrder _
  104.         :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
  105.     Workbooks(KPI).Close SaveChanges:=True
  106.     Set KPI = Nothing
  107.     Next I
  108.     MsgBox ("共用時: " & Format(Time - T, "HH:MM:SS"))
  109. End Sub
複製代碼
收藏 分享
初學VBA乍到twbts

play9091

帖子
87 
主題
24 
精華
0 
積分
122 
點名
0  
作業系統
win 7 
軟體版本
2016 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-1-16 
15#
發表於 2011-7-21 22:32 | 只看該作者
回復 14# GBKEE

感謝版大耐心的回答我的每一個爛問題……關於進階篩選的問題，我找到錯誤的地方了，就是我選擇被篩選的地方選的不夠大……所以有些的資料沒有被篩選到。
明天我又要開始我的另外一份VBA旅程，還請先進們多多指教……
我也會持續的打擾各位的！！！
初學VBA乍到twbts

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
14#
發表於 2011-7-21 19:29 | 只看該作者
回復 13# play9091
可以呀,程式碼跟上一檔案差不多,找不到錯誤.
  1. Sub ttt()
  2.     Sheets("Sheet1").Range("E3").Value = ""
  3.     Sheets("Sheet1").Range("E4").Value = "=AND(TEXT(RIGHT(A11, 8), ""hh:mm:ss"") >= ""02:00:00"",TEXT(RIGHT(A11, 8), ""hh:mm:ss"") <= ""21:30:00"")"
  4.    ' Range("A11").Select
  5.    ' Range(Selection, Selection.End(xlToRight)).Select
  6.    ' Range(Selection, Selection.End(xlDown)).Select
  7.     Range("A10:EQ5482").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
  8.         Range("E3:E4"), Unique:=False
  9. End Sub
複製代碼

TOP

play9091

帖子
87 
主題
24 
精華
0 
積分
122 
點名
0  
作業系統
win 7 
軟體版本
2016 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-1-16 
13#
發表於 2011-7-21 17:42 | 只看該作者
回復 12# GBKEE

上傳錯範例了……那個範例檔是可以成功篩選的……
上傳另外一個檔，同樣的情況，做同樣的篩選，但是確篩選不出來……我的問題是這個…版主應該會清楚我的問題

範例二.rar (773.22 KB)

初學VBA乍到twbts

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
12#
發表於 2011-7-21 17:02 | 只看該作者
本帖最後由 GBKEE 於 2011-7-21 17:04 編輯

回復 11# play9091
沒問題, 這樣進階篩選對阿.
工作表函數 ISLOGICAL 參照的值是邏輯值 傳回 TRUE    ,E4 傳回 為TRUE 或FALSE 同樣是邏輯值,
=IF(ISLOGICAL(E4)," & "" & ",A10)"    永遠傳回 ""     這公式是誤打誤撞的
  1. Sub ttt()
  2.     Sheets("Sheet1").Range("E3") = ""   
  3.    '或 Sheets("Sheet1").Range("E3") = "ABC"
  4.   ' 進階篩選 :    篩選準則 是計算是準則(條件裡有計算公式)  , 準則欄位: 不可是資料庫內的欄位 (可以是空白欄位)
  5.     '計算是準則    如E4=  A10   是篩選不到資料
  6.     Sheets("Sheet1").Range("E4").Value = "=AND(TEXT(RIGHT(A11, 8), ""hh:mm:ss"") >= ""02:00:00"",TEXT(RIGHT(A11, 8), ""hh:mm:ss"") <= ""21:30:00"")"
  7.     Range("A10").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
  8.         Range("E3:E4"), Unique:=False
  9. End Sub
複製代碼

TOP

play9091

帖子
87 
主題
24 
精華
0 
積分
122 
點名
0  
作業系統
win 7 
軟體版本
2016 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-1-16 
11#
發表於 2011-7-21 16:14 | 只看該作者
付檔為我的範例檔……
在E3和E4輸入公式，用「進階篩選」……詳見VBE

範例.rar (477.47 KB)

初學VBA乍到twbts

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2011-7-21 15:45 | 只看該作者
回復 9# play9091
上傳 檔案說明看看

TOP

play9091

帖子
87 
主題
24 
精華
0 
積分
122 
點名
0  
作業系統
win 7 
軟體版本
2016 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-1-16 
9#
發表於 2011-7-21 15:10 | 只看該作者
本帖最後由 play9091 於 2011-7-21 15:15 編輯
回復  play9091
這是工作表函數寫法  =AND(TEXT(RIGHT(A11, 8), "hh:mm:ss") >= "02:00:00",TEXT(RIGHT(A ...
GBKEE 發表於 2011-7-21 15:02


看版主的寫法是只有對A11做判別而已……但是……我要篩選的範圍有上萬個儲存格……用LOOP的話會跑很久吧！
這也是我選用進階篩選的原因……

我上面說的不知道對不對，或許是我理解不夠……是不是可以舉一個實例可以篩選的。下面是我寫的篩選內容……
  1.     Sheets("C" & I).Range("E3").Value = "=IF(ISLOGICAL(E4)," & "" & ",A10)"
  2.     Sheets("C" & I).Range("E4").Value = "=AND(TEXT(RIGHT(A11, 8), ""hh:mm:ss"") >= ""02:00:00"",TEXT(RIGHT(A11, 8), ""hh:mm:ss"") <= ""21:30:00"")"
  3.     Range("A11").Select
  4.     Range(Selection, Selection.End(xlToRight)).Select
  5.     Range(Selection, Selection.End(xlDown)).Select
  6.     Range("A10:EQ5482").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
  7.         Range("E3:E4"), Unique:=False
複製代碼
初學VBA乍到twbts

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2011-7-21 15:02 | 只看該作者
本帖最後由 GBKEE 於 2011-7-21 15:08 編輯

回復 7# play9091
這是工作表函數寫法  =AND(TEXT(RIGHT(A11, 8), "hh:mm:ss") >= "02:00:00",TEXT(RIGHT(A11, 8), "hh:mm:ss") <= "21:30:00")
你的寫法有誤 你不是有問過
  1. Sub Ex()
  2.     If TimeValue(Right(Range("A11"), 8)) >= #2:00:00 AM# And TimeValue(Right(Range("A11"), 8)) <= #9:30:00 PM# Then
  3.         MsgBox "篩選時間內"
  4.     End If
  5. '''''''' 一樣的效果   '''''''''''''
  6.     If TimeValue(Right([A11], 8)) >= TimeValue("2:00:00") And TimeValue(Right([A11], 8)) <= TimeValue("9:30:00") Then
  7.         MsgBox "篩選時間內"
  8.     End If
  9. End Sub
複製代碼

TOP

play9091

帖子
87 
主題
24 
精華
0 
積分
122 
點名
0  
作業系統
win 7 
軟體版本
2016 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-1-16 
7#
發表於 2011-7-21 12:52 | 只看該作者
本帖最後由 play9091 於 2011-7-21 13:29 編輯

沒有開的檔案都可以抓到資料  不可以的上一回覆有筆誤  以更正 ,可用匯入外部資料讀取.
OK，清楚了……

Set KPI = Workbooks.Open(KPI) , 將變數KPI指定為  Workbooks.Open(KPI) 這物件.
KPI.Close     這樣就關掉
嗯～又學到一招了，但是用這個方法的話，我上面已經指定字串給Clu了，沒有清除又指定新的資料給他，這樣子不會造成記憶體堆疊嗎？會吃比較多記憶體……而且我發現
Set KPI = Workbooks.Open(KPI)
比
set KPI = nothing
KPI = ActiveWorkbook.Name
還要慢……

應該是這樣   
Set GGG = Selection       將變數 GGG指定為 Range物件, Selection是Range物件.
所以說應該把它寫成下面這個樣子才取得出來囉！
Set GGG = Selection
Set BBB.Value =  GGG.Value
才可以「只取出值」囉！等一下試試……
剛剛試了……我失敗了……

另外：進階篩選有時候會出錯，這要怎麼樣子去除錯呢？？
有一大筆資料，我要篩選出0200<=X<=2130
所以我寫了這個判別式：
=AND(TEXT(RIGHT(A11, 8), "hh:mm:ss") >= "02:00:00",TEXT(RIGHT(A11, 8), "hh:mm:ss") <= "21:30:00")
它有時候會成功，有時候會失敗這應該怎麼做呢？？
初學VBA乍到twbts

TOP

        靜思自在 : 我們要做好社會的環保，也要做好內心的環保。
12
返回列表 上一主題