返回列表 上一主題 發帖

[分享] 優化巨大的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 
2#
發表於 2011-7-21 09:39 | 顯示全部帖子
本帖最後由 play9091 於 2011-7-21 09:53 編輯

我把它修改成下面的樣子，不要用「inputbox」直接在sheet裡面把路俓先寫好，這樣子就不用等「inputbox」跳出來。
但是它確出現了「超出索引範圍」代號9的錯誤，我只要把BOOK的物件拿掉就正常了，但我必須要指定BOOK比較不會出錯。我試了好多方法，它就是不給動作，不知道是不是我漏了什麼地方，煩請先進指導一下！！！
  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 = Workbooks("路俓版").Sheets("工作表3").Range("D" & I).Value  '←這裡出錯！！！
  8.     Workbooks.Open (KPI)
  9.     Set KPI = Nothing
  10.     KPI = ActiveWorkbook.Name
複製代碼
另外，板主回複的簡化方式
  1. Set KPI = Workbooks.Open(KPI)
複製代碼
這取出來的是全部關於BOOK的內容，我只須要BOOK的檔名而已！！！應該是用不上！而且我下面必須要用到BOOK的名字，精確一點應該會比較好！
初學VBA乍到twbts

TOP

play9091

帖子
87 
主題
24 
精華
0 
積分
122 
點名
0  
作業系統
win 7 
軟體版本
2016 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-1-16 
3#
發表於 2011-7-21 11:08 | 顯示全部帖子
試看看   Workbooks("路俓版.XLS")   這檔案不需是已開啟的.\
YES！！！真的搞定了，版大真強，這招先學起來……用這個方法是不是連沒有開的檔案都可以抓到資料？？

我將你的程式碼簡化是配合你的程序需求
1樓的程式碼有
Workbooks(Clu).Close SaveChanges:=False     '這不是之前 將檔案開啟 後作關閉的動作嗎?

它的確是關閉之前開啟的檔案沒有錯，但是Workbooks(Clu)裡面的「Clu」必須是精確的檔名，要不然會關不掉……

另外：我想要只複製一個「範圍」的「值」，我還想不到怎麼做，因為一次要複製的資料太多了(百萬級的)！複製的時候要等很久……有沒有可以「只複製值」的方法！
我想了一些，但都沒有成功……請先進們指導一下如何只取值！！！
  1.     Sheets("C" I).Select
  2.     Range("A11").Select
  3.     Range(Selection, Selection.End(xlToRight)).Select
  4.     Range(Selection, Selection.End(xlDown)).Select
  5.     set GGG.value = selection.value   '出錯
複製代碼
初學VBA乍到twbts

TOP

play9091

帖子
87 
主題
24 
精華
0 
積分
122 
點名
0  
作業系統
win 7 
軟體版本
2016 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-1-16 
4#
發表於 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

play9091

帖子
87 
主題
24 
精華
0 
積分
122 
點名
0  
作業系統
win 7 
軟體版本
2016 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-1-16 
5#
發表於 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

play9091

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

範例.rar (477.47 KB)

初學VBA乍到twbts

TOP

play9091

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

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

範例二.rar (773.22 KB)

初學VBA乍到twbts

TOP

play9091

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

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

TOP

        靜思自在 : 人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。
返回列表 上一主題