12
返回列表 上一主題 發帖

[發問] 大筆資料篩選，速度很慢(篩選及排列)

lifedidi

帖子
104 
主題
32 
精華
0 
積分
144 
點名
0  
作業系統
windowsXP 
軟體版本
2007 
閱讀權限
20 
性別
男 
註冊時間
2013-2-25 
最後登錄
2022-9-2 

論壇贊助勳章
5# 跳轉到 »
發表於 2013-5-2 13:44 | 只看該作者
本帖最後由 lifedidi 於 2013-5-2 13:47 編輯

回復 4# Hsieh


大大好：

改用大大的語法後，run起來有快很多，但還是有個地方有問題
請問大大一個問題，
我一直交叉測試發現到，
篩選並貼上的語法，很費時間，
程式碼如下：
  1. Dim HH As Range, KK As Range, PP As Range
  2. Set PP = .[A6]
  3.        .[A1:W65536].ClearContents
  4. HH.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=KK,
複製代碼
【假設五千筆資料】
run起來，資料一筆一筆貼上，貼到五千筆需要不少時間，
(我將儲存格拉至5000列處，按執行，發現要一段時間才會run到五千筆，因此判斷是這問題)
可是我把一樣的資料原封不動的貼到新sheet檔(new excel file)，在run，不到一秒就跑完了，(........)

(PS)整個excel檔案有約20個userform每個都篩選不同條件，小弟在猜想，這樣會不會造成excel執行時的緩慢？
請益大大意見，小弟現在頭好暈=.= 感謝

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
257  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-28 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2013-4-30 19:47 | 只看該作者
回復 3# lifedidi
用你原來的進階篩選
統計部分改用函數計算即可
  1. Private Sub CommandButton1_Click()  '查詢鈕
  2.     Dim d1 As Date, d2 As Date
  3.     Dim Srng As Range, Crng As Range, Orng As Range
  4.     Set Srng = Sheets("SHEET1").[A6].CurrentRegion
  5.     Set Crng = Sheets("篩選用").[A1:A2]
  6.     With Sheets("SHEET2")
  7.         Set Orng = .[A6]
  8.         .[A1:W65536].ClearContents
  9.         Srng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Crng, CopyToRange:=Orng
  10.         If .[A7].Value = "" Then
  11.             MsgBox "沒資料", vbCritical + vbOKOnly, "注意"
  12.             Exit Sub
  13.         End If
  14.     TextBox1.Value = Application.Text(Application.Sum(.[R:R]), "[hh]:mm")
  15.     End With
  16. End Sub
複製代碼
學海無涯_不恥下問

TOP

lifedidi

帖子
104 
主題
32 
精華
0 
積分
144 
點名
0  
作業系統
windowsXP 
軟體版本
2007 
閱讀權限
20 
性別
男 
註冊時間
2013-2-25 
最後登錄
2022-9-2 

論壇贊助勳章
3#
發表於 2013-4-30 17:37 | 只看該作者
回復 2# GBKEE


    GBKEE大大好：

測試過OK，但是沒有將篩選的資料貼於SHEET2，是否請大大在編一下，

小弟研究一下大大的註解;P 感謝。

TOP

GBKEE

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

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

回復 1# lifedidi
試試看
  1. Private Sub UserForm_Initialize()   '基本設定
  2.   '  Set 型號 = CreateObject("Scripting.Dictionary")  '耗時:須跑完所有資料列
  3.     Dim X As Integer
  4.    ' Sheets("篩選用").[A2:A2].ClearContents
  5.     With Sheets("SHEET1")
  6.         'er = .[A65536].End(3).Row
  7.         'myrng = .Range("A7:R" & er)        '資料數來到10000筆以上時 ***這會佔用記憶體***
  8.          .Cells(1, .Columns.Count) = ""
  9.         .Range("D6", .[D6].End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
  10.         '進階篩選 D欄 不重複資料 Unique:=True 到最後一欄
  11.         X = 2
  12.         Do While .Cells(X, .Columns.Count) <> ""
  13.             ComboBox1.AddItem .Cells(X, .Columns.Count)
  14.             X = X + 1
  15.         Loop
  16.         .Columns(.Columns.Count).EntireColumn.Clear   '清除 最後一欄資料
  17.     End With
  18. End Sub
  19. Private Sub ComboBox1_Change()  '選擇 下拉式選單1 立即顯示總總時間;可不用查詢鈕
  20.     If ComboBox1.ListIndex = -1 Then   '不在下拉式選單的清單內
  21.         MsgBox "專案編號 編號 " & ComboBox1 & " 不正確"
  22.     Else
  23.         Application.ScreenUpdating = False
  24.         With Sheets("SHEET1")
  25.             .Range("a6").AutoFilter Field:=4, Criteria1:=ComboBox1            'AutoFilter:  原資料庫上自動篩選.
  26.             With .Range("r:r").SpecialCells(xlCellTypeVisible)
  27.                 TextBox1.Value = Application.Text(Application.Sum(.Cells), "[hh]:mm")
  28.             End With
  29.             .AutoFilterMode = False
  30.         End With
  31.         Application.ScreenUpdating = True
  32.     End If
  33. End Sub
  34. Private Sub CommandButton3_Click()  '離開鈕
  35.     Unload UserForm1
  36. End Sub
  37. Private Sub UserForm_Terminate()    '重新排列
  38.     'Sheets("SHEET1").Range("A7:R" & er) = myrng   '重新填上資料耗時
  39. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 【是否發揮了良能？】人間壽命因為短暫，才更顯得珍貴。難得來一趟人間，應問是否為人間發揮了自己的良能，而不要一味求長壽。
12
返回列表 上一主題