Hsieh

回復 10# lifedidi
不是很清楚你要甚麼，試試看附件流程看是否符合需求

工時系統excel版本).rar (51.31 KB)

下載次數: 13

2013-2-27 23:24

lifedidi

回復 11# Hsieh


    感謝大大的不辭辛勞，看了你的流程感覺更順暢，我修改一下我的問題並把問題寫在excel裡，謝謝。

工時系統excel版本)20130228.rar (80.41 KB)

下載次數: 8

2013-2-28 13:00

GBKEE

回復 12# lifedidi
1有辦法照順序

1. Private Sub UserForm_Initialize()  '表單初始化的程序
   
2.     Dim D As Object
   
3.     Set D = CreateObject("Scripting.Dictionary")    '字典物件
   
4.     With Sheet1
   
5.         For Each a In .Range(.[D7], .[D7].End(xlDown))
   
6.             D(a.Value) = ""
   
7.         Next
   
8.     End With
   
9.     ComboBox1.List = D.keys       '專案選項內容
   
10. End Sub
    
11. Private Sub ComboBox1_Change()      '專案選項內容: 有改變
    
12.     If ComboBox1.ListIndex > -1 Then
    
13.         ComboBox2資料
    
14.     Else                            '改變的內容不在List中
    
15.         ComboBox2.Clear
    
16.     End If
    
17. End Sub
    
18. Private Sub ComboBox2資料()
    
19.     Dim D As Object
    
20.     Set D = CreateObject("Scripting.Dictionary")
    
21.     With Sheet1
    
22.         For Each a In .Range(.[D7], .[D7].End(xlDown))
    
23.             If a.Value = ComboBox1 Then D(a.Offset(, 3).Value) = ""    '
    
24.         Next
    
25.         With .Columns(.Columns.Count).EntireColumn           'Sheet1的最後一欄
    
26.             .Clear
    
27.             .Cells(1).Resize(D.Count, 1) = Application.WorksheetFunction.Transpose(D.keys)
    
28.             '*** 排序
    
29.             .Cells(1).Resize(D.Count, 1).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:= _
    
30.                     xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    
31.                     SortMethod:=xlStroke, DataOption1:=xlSortNormal
    
32.             '*******
    
33.             ComboBox2.List = .Cells(1).Resize(D.Count, 1).Value  '工種選項內容
    
34.             ComboBox2.Value = ComboBox2.List(0)                  '工種選項的值
    
35.             .Clear
    
36.         End With
    
37.     End With
    
38. End Sub

複製代碼

2電腦不吃力

1. Public Sub 清除()
   
2.     With Sheet2
   
3.         '.Cells(7, 3).Resize(999 - 7 + 1, 25 - 3 + 1) = ""
   
4.         .Cells(7, 3).Resize(993, 23) = ""
   
5.         'For i = 7 To 999
   
6.         '    For j = 3 To 25
   
7.         '   Cells(i, j) = ""
   
8.         '   Next
   
9.         ' Next
   
10.     End With
    
11. End Sub

複製代碼

lifedidi

回復 13# GBKEE

抱歉，最近工作比較忙，感謝兩位大大的幫忙，清除的指令OK了:) ，但是兩條件的篩選我將程式碼貼上去還是跑不出來，

簡化了一下表單

兩個條件篩選.rar (42.34 KB)

下載次數: 10

2013-3-2 17:58

我把問題用圖形表達，謝謝。

GBKEE

回復 14# lifedidi
附檔中UserForm1的程式碼

1. Private Sub UserForm_Initialize()                   '表單初始化的程序
   
2.     Dim D As Object
   
3.     Set D = CreateObject("Scripting.Dictionary")    '字典物件
   
4.     Sheet2.Range("b1").CurrentRegion.Offset(1) = "" '先清除舊資料
   
5.     With Sheet1
   
6.         .AutoFilterMode = False                     '取消自動篩選模式
   
7.         For Each A In .Range(.[A2], .[A2].End(xlDown))
   
8.             D(A.Value) = ""
   
9.         Next
   
10.         ComboBox1.List = D.KEYS                     '專案選項內容
    
11.     End With
    
12. End Sub
    
13. Private Sub ComboBox1_Change()                      '專案選項內容: 有改變
    
14.      With Sheet1
    
15.         .AutoFilterMode = False
    
16.         If ComboBox1.ListIndex > -1 Then
    
17.             ComboBox2資料
    
18.             .Range("a1").AutoFilter 1, ComboBox1    '自動篩選模式:第1欄的篩選準則為 ComboBox1的值
    
19.         Else                                        '改變的內容不在List中
    
20.             .Range("a1").AutoFilter 1, "<>"         '自動篩選模式:第1欄的篩選準則為不是空白欄
    
21.             ComboBox2.Clear
    
22.         End If
    
23.         資料複製
    
24.     End With
    
25. End Sub
    
26. Private Sub ComboBox2_Change()                      '專案選項內容: 有改變
    
27.     If ComboBox2.ListIndex > -1 Then
    
28.         Sheet1.Range("a1").AutoFilter 2, ComboBox2  '自動篩選模式:第2欄的篩選準則為 ComboBox2的值
    
29.     Else
    
30.         Sheet1.Range("a1").AutoFilter 2, "<>"       '自動篩選模式:第2欄的篩選準則為不是空白欄
    
31.     End If
    
32.     資料複製
    
33. End Sub
    
34. Private Sub ComboBox2資料()
    
35.     Dim D As Object, A
    
36.     Set D = CreateObject("Scripting.Dictionary")
    
37.     With Sheet1
    
38.         For Each A In .Range(.[A2], .[A2].End(xlDown))
    
39.             If A.Value = ComboBox1 Then D(A.Offset(, 1).Value) = ""
    
40.         Next
    
41.         If D.Count > 1 Then
    
42.             With .Columns(.Columns.Count).EntireColumn           'Sheet1的最後一欄
    
43.                 .Clear
    
44.                 .Cells(1).Resize(D.Count, 1).Value = Application.WorksheetFunction.Transpose(D.KEYS)
    
45.                 '*** 排序
    
46.                 .Cells(1).Resize(D.Count, 1).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:= _
    
47.                     xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    
48.                     SortMethod:=xlStroke, DataOption1:=xlSortNormal
    
49.                 '*******
    
50.                 ComboBox2.List = .Cells(1).Resize(D.Count, 1).Value  '工種選項內容
    
51.                 .Clear
    
52.             End With
    
53.         Else
    
54.             A = D.KEYS
    
55.             ComboBox2.AddItem A(0)
    
56.         End If
    
57.             ComboBox2.Value = ComboBox2.List(0)                  '工種選項的值
    
58.     End With
    
59. End Sub
    
60. Private Sub 資料複製()
    
61.     Dim Rng As Range
    
62.     Sheet2.Range("b1").CurrentRegion = ""             '先清除舊資料
    
63.     Sheet1.Range("a1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Sheet2.Range("b1")
    
64.     '複製:'自動篩選出的資料
    
65. End Sub
    
66. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    
67.     Sheet1.AutoFilterMode = False      '表單關閉前取消自動篩選模式
    
68. End Sub

複製代碼

lifedidi

回復 15# GBKEE


小弟這幾天在研究VBA，首先感謝兩位大大的程式碼，

對VBA也有些眉目了，不過很傷精神就對了...目前兩條件篩選OK了，

現在我把工時加總套用上去，發生了問題，也稍做些修改還是不行

希望大大能幫小弟解惑，感恩不盡。

問題在附件裡，小弟盡量表達我的問題所在，謝謝。

工時系統exce20130311.rar (76.29 KB)

下載次數: 7

2013-3-11 22:55

GBKEE

回復 16# lifedidi

1. Dim 資料表 As Worksheet  '***設定資料工作表 供表單中的程序共同使用 ***
   
2. Dim 查詢表 As Worksheet  '***設定資料工作表 供表單中的程序共同使用 ***
   
3. Private Sub UserForm_Initialize()  '表單初始化的程序
   
4.     Dim D As Object
   
5.     Set D = CreateObject("Scripting.Dictionary")    '字典物件
   
6.     Set 資料表 = Sheet1      ' 資料工作表 或 查詢工作表 的工作表 如有變動時
   
7.     Set 查詢表 = Sheet2      ' 在此修改:不必去所有程式碼中一一修改工作表名稱
   
8.     With 資料表
   
9.         .AutoFilterMode = False
   
10.         For Each a In .Range(.[A2], .[A2].End(xlDown))
    
11.             D(a.Value) = ""
    
12.         Next
    
13.     End With
    
14.     ComboBox1.List = D.keys       '專案選項內容
    
15. End Sub
    
16. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    
17.         '表單關閉的程序
    
18.         資料表.AutoFilterMode = False                             '取消自動篩選
    
19.         查詢表.UsedRange.Offset(1) = ""
    
20. End Sub
    
21. Private Sub CommandButton1_Click()
    
22.     '*** UserForm2 的ListBox1 改成 TextBox 控制項             *****
    
23.     With UserForm2
    
24.         .TextBox1 = Application.Text(Application.Sum(查詢表.[D:D]), "[hh]:mm")
    
25.         .Show 0
    
26.     End With
    
27. End Sub
    
28. Private Sub ComboBox1_Change()      '專案選項內容: 有改變
    
29.     If ComboBox1.ListIndex > -1 Then
    
30.         ComboBox2資料
    
31.     Else                            '改變的內容不在List中
    
32.         ComboBox2.Clear
    
33.     End If
    
34.     Show_資料
    
35. End Sub
    
36. Private Sub ComboBox2_Change()      '專案選項內容: 有改變
    
37.     Show_資料
    
38. End Sub
    
39. Private Sub ComboBox2資料()
    
40.     Dim D As Object
    
41.     Set D = CreateObject("Scripting.Dictionary")
    
42.     With 資料表
    
43.         .AutoFilterMode = False
    
44.         For Each a In .Range(.[A2], .[A2].End(xlDown))
    
45.             If a.Value = ComboBox1 Then D(a.Offset(, 1).Value) = ""    '
    
46.         Next
    
47.         With .Columns(.Columns.Count).EntireColumn           'Sheet1的最後一欄
    
48.             .Clear
    
49.             .Cells(1).Resize(D.Count, 1) = Application.WorksheetFunction.Transpose(D.keys)
    
50.             '*** 排序
    
51.             .Cells(1).Resize(D.Count, 1).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:= _
    
52.                     xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    
53.                     SortMethod:=xlStroke, DataOption1:=xlSortNormal
    
54.             '*******
    
55.             ComboBox2.List = .Cells(1).Resize(D.Count, 1).Value  '工種選項內容
    
56.             ComboBox2.Value = ComboBox2.List(0)                  '工種選項的值
    
57.             .Clear
    
58.         End With
    
59.     End With
    
60. End Sub
    
61. Private Sub Show_資料()
    
62.     UserForm2.TextBox1 = ""
    
63.     With 資料表
    
64.         .AutoFilterMode = False                             '取消自動篩選
    
65.         If ComboBox1.ListIndex > -1 Then
    
66.             .Range("A1").AutoFilter 1, ComboBox1            '自動篩選: 第一欄(A欄)的準則 為 ComboBox1
    
67.             If ComboBox2.ListIndex > -1 Then
    
68.                 .Range("A1").AutoFilter 2, ComboBox2        '自動篩選: 第一欄(A欄)的準則 為 ComboBox12
    
69.             End If
    
70.         End If
    
71.         .UsedRange.Range("A:C").Copy 查詢表.[B1]            '資料表:自動篩選出的資料 複製到 查詢表
    
72.     End With
    
73. End Sub

複製代碼

lifedidi

回復 17# GBKEE


大大，

ComboBox2資料、Show_資料可以更深入解釋嗎？

我把變數套用excel檔，卡在第71列，不知道怎麼修改，感謝你！

GBKEE

回復 18# lifedidi
卡在第71列 可能是2007 不接受這寫法 請修改如下

1. Private Sub ComboBox2資料()  'ComboBox1有異動:尋找 [工種]欄位的字串
   
2.     Dim D As Object
   
3.     Set D = CreateObject("Scripting.Dictionary")
   
4.     With 資料表
   
5.         .AutoFilterMode = False
   
6.         For Each a In .Range(.[A2], .[A2].End(xlDown))
   
7.             
   
8.             If a.Value = ComboBox1 Then D(a.Offset(, 1).Value) = ""
   
9.             '符合ComboBox1 的 [工種]中-> 字典物件:D(Key) -> D(工種的字串)
   
10.         Next
    
11.        '** 以下程式碼將 字典物件:D(Key)的字串複製在最後一欄
    
12.        '** 之後加以排序然後設為 ComboBox2.List
    
13.        With .Columns(.Columns.Count).EntireColumn           'Sheet1的最後一欄
    
14.             .Clear
    
15.             .Cells(1).Resize(D.Count, 1) = Application.WorksheetFunction.Transpose(D.keys)
    
16.             '*** 排序
    
17.             .Cells(1).Resize(D.Count, 1).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:= _
    
18.                     xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    
19.                     SortMethod:=xlStroke, DataOption1:=xlSortNormal
    
20.             '*******
    
21.             ComboBox2.List = .Cells(1).Resize(D.Count, 1).Value  '工種選項內容
    
22.             ComboBox2.Value = ComboBox2.List(0)                  '工種選項的值
    
23.             '**
    
24.         End With
    
25.     End With
    
26. End Sub
    
27. Private Sub Show_資料()    '** 資料表中 自動篩選
    
28.     With 資料表
    
29.         .AutoFilterMode = False        '取消自動篩選-> 資料全部顯示出來:新篩選後的資料才會正確
    
30.         If ComboBox1.ListIndex > -1 Then
    
31.             .Range("A1").AutoFilter 1, ComboBox1            '自動篩選: 第一欄(A欄)的準則 為 ComboBox1
    
32.             If ComboBox2.ListIndex > -1 Then
    
33.                 .Range("A1").AutoFilter 2, ComboBox2        '自動篩選: 第一欄(A欄)的準則 為 ComboBox12
    
34.             End If
    
35.         End If
    
36.         '.UsedRange.Range("A:C").Copy 查詢表.[B1]
    
37.         .Range("A:C").Copy 查詢表.[B1]                       '資料表:自動篩選出的資料 複製到 查詢表
    
38.     End With
    
39. End Sub

複製代碼

.Range("A1").AutoFilter 1, ComboBox1   如圖

下載 (29.59 KB)

2013-3-12 10:14

lifedidi

第37列
.Range("A:C").Copy 查詢表.[C7]                      '資料表:自動篩選出的資料 複製到 查詢表

大大，

請問【Range("A:C")】要如何修改呢？我套用我資料表("A:R")還是偵錯。