- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 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
複製代碼 |
|