1234
返回列表 上一主題 發帖

[發問] 下拉式清單裡選擇"篩選不重複的資料"

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
11# 跳轉到 »
發表於 2013-2-27 23:24 | 只看該作者
回復 10# lifedidi
不是很清楚你要甚麼，試試看附件流程看是否符合需求

工時系統excel版本).rar (51.31 KB)
學海無涯_不恥下問

TOP

lifedidi

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

論壇贊助勳章
12#
發表於 2013-2-28 13:00 | 只看該作者
回復 11# Hsieh


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

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

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
13#
發表於 2013-2-28 16:57 | 只看該作者
回復 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
複製代碼

TOP

lifedidi

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

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

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

簡化了一下表單

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

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

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
15#
發表於 2013-3-2 21:12 | 只看該作者
回復 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
複製代碼

TOP

lifedidi

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

論壇贊助勳章
16#
發表於 2013-3-11 22:57 | 只看該作者
回復 15# GBKEE


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

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

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

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

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

工時系統exce20130311.rar (76.29 KB)

TOP

GBKEE

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

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

回復 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
複製代碼

TOP

lifedidi

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

論壇贊助勳章
18#
發表於 2013-3-12 09:16 | 只看該作者
回復 17# GBKEE


大大，

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

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

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
19#
發表於 2013-3-12 10:14 | 只看該作者
回復 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   如圖

TOP

lifedidi

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

論壇贊助勳章
20#
發表於 2013-3-12 10:48 | 只看該作者
第37列
.Range("A:C").Copy 查詢表.[C7]                      '資料表:自動篩選出的資料 複製到 查詢表

大大，

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

TOP

        靜思自在 : 願要大、志要堅、氣要柔、心要細。
1234
返回列表 上一主題