麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 大筆資料篩選，速度很慢(篩選及排列) [打印本頁]

作者: lifedidi 時間: 2013-4-30 15:41 標題: 大筆資料篩選，速度很慢(篩選及排列)

本帖最後由 lifedidi 於 2013-4-30 15:42 編輯

大大好：

小弟有一個工時的EXCEL檔，交給同事使用，

起初100筆or500筆資料都可以很順，功能也都ok！

但是當資料數來到10000筆以上時，開始變慢了！

查詢一筆資料要等很久，雖然還是跑得出來..

請教大大有沒有更好的寫法呢？

有幾個要點：
1.資料要篩選出並貼在Sheet2上
2.貼於Sheet2的資料需要照日期排序
3.統計篩選後資料中 R欄時間的總和

測試檔資料數1.6W筆，公司電腦要跑2~3分鐘，
有點久...請大大小心:L
[attach]14830[/attach]

作者: GBKEE 時間: 2013-4-30 17:08

本帖最後由 GBKEE 於 2013-4-30 17:11 編輯

回復 1# lifedidi
試試看

Private Sub UserForm_Initialize() '基本設定
' Set 型號 = CreateObject("Scripting.Dictionary") '耗時:須跑完所有資料列
Dim X As Integer
' Sheets("篩選用").[A2:A2].ClearContents
With Sheets("SHEET1")
'er = .[A65536].End(3).Row
'myrng = .Range("A7:R" & er) '資料數來到10000筆以上時 ***這會佔用記憶體***
.Cells(1, .Columns.Count) = ""
.Range("D6", .[D6].End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
'進階篩選 D欄不重複資料 Unique:=True 到最後一欄
X = 2
Do While .Cells(X, .Columns.Count) <> ""
ComboBox1.AddItem .Cells(X, .Columns.Count)
X = X + 1
Loop
.Columns(.Columns.Count).EntireColumn.Clear '清除最後一欄資料
End With
End Sub
Private Sub ComboBox1_Change() '選擇下拉式選單1 立即顯示總總時間;可不用查詢鈕
If ComboBox1.ListIndex = -1 Then '不在下拉式選單的清單內
MsgBox "專案編號編號 " & ComboBox1 & " 不正確"
Else
Application.ScreenUpdating = False
With Sheets("SHEET1")
.Range("a6").AutoFilter Field:=4, Criteria1:=ComboBox1 'AutoFilter: 原資料庫上自動篩選.
With .Range("r:r").SpecialCells(xlCellTypeVisible)
TextBox1.Value = Application.Text(Application.Sum(.Cells), "[hh]:mm")
End With
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End If
End Sub
Private Sub CommandButton3_Click() '離開鈕
Unload UserForm1
End Sub
Private Sub UserForm_Terminate() '重新排列
'Sheets("SHEET1").Range("A7:R" & er) = myrng '重新填上資料耗時
End Sub

複製代碼

作者: lifedidi 時間: 2013-4-30 17:37

回復 2# GBKEE

GBKEE大大好：

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

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

作者: Hsieh 時間: 2013-4-30 19:47

回復 3# lifedidi
用你原來的進階篩選
統計部分改用函數計算即可

Private Sub CommandButton1_Click() '查詢鈕
Dim d1 As Date, d2 As Date
Dim Srng As Range, Crng As Range, Orng As Range
Set Srng = Sheets("SHEET1").[A6].CurrentRegion
Set Crng = Sheets("篩選用").[A1:A2]
With Sheets("SHEET2")
Set Orng = .[A6]
.[A1:W65536].ClearContents
Srng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Crng, CopyToRange:=Orng
If .[A7].Value = "" Then
MsgBox "沒資料", vbCritical + vbOKOnly, "注意"
Exit Sub
End If
TextBox1.Value = Application.Text(Application.Sum(.[R:R]), "[hh]:mm")
End With
End Sub

複製代碼

作者: lifedidi 時間: 2013-5-2 13:44

本帖最後由 lifedidi 於 2013-5-2 13:47 編輯

回復 4# Hsieh

大大好：

改用大大的語法後，run起來有快很多，但還是有個地方有問題
請問大大一個問題，
我一直交叉測試發現到，
篩選並貼上的語法，很費時間，
程式碼如下：

Dim HH As Range, KK As Range, PP As Range
Set PP = .[A6]
.[A1:W65536].ClearContents
HH.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=KK,

複製代碼

【假設五千筆資料】
run起來，資料一筆一筆貼上，貼到五千筆需要不少時間，
(我將儲存格拉至5000列處，按執行，發現要一段時間才會run到五千筆，因此判斷是這問題)
可是我把一樣的資料原封不動的貼到新sheet檔(new excel file)，在run，不到一秒就跑完了，(........)

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

作者: GBKEE 時間: 2013-5-2 15:31

回復 5# lifedidi
run起來，資料一筆一筆貼上，貼到五千筆需要不少時間，
為何要資料一筆一筆貼上???

作者: lifedidi 時間: 2013-5-2 15:41

回復 4# Hsieh

大大好：

因為同事需要【工時加總(單、多條件篩選)】【資料瀏覽】的功能，所以目前小弟先以這功能去加強。

請參考附件。

【建立在相同狀況下】
50,000筆資料處理數度快
3,000筆資料處裡數度卻較慢

請大大抽空時測試看看，謝謝。

小弟繼續研究XD

[attach]14867[/attach]

作者: lifedidi 時間: 2013-5-2 15:47

回復 6# GBKEE

大大好：

不知道是因為公司電腦關係還是其他元素，
如同上面的回覆，

30000筆資料是快速的copy上sheet (上方的回覆內容打錯50000，更正為30000)

3000筆資料卻是一筆一筆的copy上sheet

(一筆一筆貼上是誇飾法..請見諒)

作者: GBKEE 時間: 2013-5-2 16:35

本帖最後由 GBKEE 於 2013-5-2 16:54 編輯

回復 8# lifedidi
不會罷!!
CPU 雙處理器 3.40 GHz 1GB的RAM
測試 3000筆資料費時1秒 , 30000筆資料費時4秒.

Private Sub CommandButton1_Click() '查詢鈕
Dim d1 As Date, d2 As Date, T As Date
Dim Srng As Range, Crng As Range, Orng As Range
T = Time
' 程式碼.... 為何不用4# Hsieh 超版的程式碼
'程式碼....
'程式碼....
TextBox1.Value = Format(hh, "00") & ":" & Format(mm, "00")
MsgBox Application.Text(Time - T, "[SS]秒") '顯示執行過程的時間
End Sub

複製代碼

如在30000筆資料的工作表上用自動篩選取的資料會更快的

Private Sub ComboBox1_Change() '選擇下拉式選單1 立即顯示總總時間;可不用查詢鈕
Dim T As Date
T = Time
If ComboBox1.ListIndex = -1 Then '不在下拉式選單的清單內
TextBox1 = ""
MsgBox "專案編號編號 " & ComboBox1 & " 不正確"
Else
Application.ScreenUpdating = False
With Sheets("工時資料庫")
.Range("a6").AutoFilter Field:=4, Criteria1:=ComboBox1 'AutoFilter: 原資料庫上自動篩選.
With .Range("r:r").SpecialCells(xlCellTypeVisible)
TextBox1.Value = Application.Text(Application.Sum(.Cells), "[hh]:mm")
End With
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
MsgBox Format(Time - T, " SS 秒")
End If
End Sub

複製代碼

作者: lifedidi 時間: 2013-5-2 19:24

本帖最後由 lifedidi 於 2013-5-2 19:25 編輯

回復 9# GBKEE

to GBKEE大大

小弟的語法：

【A.於sheet1篩選資料】→【B.於sheet2貼上資料】→【C.sheet2做時間加總】

※小弟在於B.會跑很久，下班回到家也是同樣情形，情形大概如附檔(影片)

[attach]14869[/attach][attach]14870[/attach]

真邪門XD

GBKEE大大的語法：

【於sheet1篩選資料】→【於sheet1時間加總】

※請問大大篩選資料可以多條件篩選嗎？假設同時要篩選：專案編號、職工編號、日期‧‧‧的條件。(請參考EXCEL檔案第二種查詢)

──────────────────────────────────────────────────────────────
Hsieh大大的程式碼也會有同樣的問題(複製貼上需要時間)，

但是我將時間加總的語法改成Hsieh大大的語法，比較簡潔，哈XD

──────────────────────────────────────────────────────────────
GBKEE大大太神了吧，運算時間竟然也可以算的出來...

[attach]14871[/attach][attach]14872[/attach]

作者: lifedidi 時間: 2013-5-3 18:16

回復 9# GBKEE

大大好：

請問大大是2003的嗎？

今天有用其他同事2003版本的run，結果就正常多了。

不知道是版本問題還是電腦問題，謝謝大大的幫忙。

作者: GBKEE 時間: 2013-5-3 20:42

回復 11# lifedidi
可能是2003結構沒有2007緊密(龐大) 所以運算速度會快些
11# 篩選資料可以多條件篩選嗎？假設同時要篩選：專案編號、職工編號、日期‧‧‧的條件。(請參考EXCEL檔案第二種查詢)
參考附件 [attach]14884[/attach]

作者: clianghot546 時間: 2014-7-24 17:35

正需要此功能,可是小學生無法下載附件研究

作者: clianghot546 時間: 2014-7-24 17:40

GBKEE 大可否將檔案寄至[email protected]，感謝您

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