[發問] 先不重複篩選後，並自動設為下拉式選單

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

2^#

發表於 2020-5-17 13:18 | 顯示全部帖子

回復 2# 准提部林

感謝版主提供檔案
但是我看按鈕裡面似乎沒有程式碼

目前需求是這樣
基本上工作表1是保持空的
如果有請購單據進來的話，才會開始逐筆打資料進去
打完後會剪走，讓工作表1又保持乾淨空的狀態

只是要打  [工作計畫用途別用途類別] 的時候
方法一，用手慢慢打
方法二，設定資料驗證，設定去找 [清單]裡面的範圍工作計畫設定一次用途別設定一次    用途類別設定一次
            然後每一筆資料該填什麼，就去下拉選擇

方法三，利用VBA設一個按鈕，把方法二的程序都自動化。
            要使用的時候就按一下產生，選完後剪走，讓工作表1又保持乾淨空的狀態


現在目標有幾個
目前可以做到按下按鈕，就自動把篩選不重複後的東西，貼到某欄
但是可能現在篩選後有四種，但是參照表以後修改，可能篩選後會變六種

With Sheets("工作表2")
.UsedRange.Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("工作表2").Range( _
"F1"), Unique:=True
Set Rng =.Range("F1").CurrentRegion
End With

複製代碼

<目標一>如何讓程式判斷，現在{清單}的[用途類別(科目)]..篩選後有幾種
<目標二>判斷有幾種後，將這個..幾種類別...設定給....工作表1的...[用途類別]那一欄...的下拉式選單

Range("I1").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Sheets("工作表2").Rng '"=工作表2!$C$2:$C$7"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With

複製代碼

設定來源那邊有問題 Formula1:=

<目標三>自動設定50列都有下拉式選單

Selection.AutoFill Destination:=Range("I1:I50"), Type:=xlFillDefault

複製代碼

<遠程目標>
若是目標一二都能達成，則 [用途類別] 的下拉選擇某一類後， [工作計畫]跟[用途別]可能自動產生相對應的值出來 (能參考{清單}中的表
例如：
[用途類別](I欄) 的下拉選擇......離職儲金之後
那麼
[用途別](H欄)，會自動放入.....人事費
[工作計畫](G欄)，會自動放入....公司業務

如果程式有辦法做到的話
再麻煩版主及其他大大協助指點，謝謝

哈囉~大家好呀

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

3^#

發表於 2020-5-18 23:03 | 顯示全部帖子

回復 5# n7822123

感謝你的幫忙，我自己後來有找到方法了，會貼在最下面的回應
再與大大您分享交流

哈囉~大家好呀

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

4^#

發表於 2020-5-18 23:09 | 顯示全部帖子

本帖最後由 iceandy6150 於 2020-5-18 23:12 編輯

回復 6# 准提部林

版主您好，我後來想了個土方法

我知道可以選定一個大範圍，給他定義名稱
然後VLOOKUP這個函數只能找...一個範圍內，最左邊那欄當標準

所以原本 A欄 B欄 C欄，就複製到別的地方，變成C欄，B欄，A欄
然後VLOOKUP C欄，可以找到相對應的A跟B
(其實用FIND好像也可以)

至於下拉式選單的內容，因為進階篩選過後，把篩選過的範圍，定義名稱
再把這個名稱給下拉式選單 (來源為變數)
這邊要配合 INDIRECT 這個語法，才能正常使用，也是網路查到的

以下是程式碼
跟測試檔案
(目前自動產生下拉清單只設定5格)

Private Sub CommandButton1_Click()
Range("A2:C20").Select
Selection.ClearContents
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
Range("C2").Select
End Sub
'*******************************************************************************
Private Sub CommandButton2_Click()
Dim a, b, c, d
Sheets("工作表2").Select
With Sheets("工作表2")
'每次執行先將最右邊四欄砍光
.Columns(.Columns.Count).Delete Shift:=xlShiftLeft
.Columns(.Columns.Count - 1).Delete Shift:=xlShiftLeft
.Columns(.Columns.Count - 2).Delete Shift:=xlShiftLeft
.Columns(.Columns.Count - 3).Delete Shift:=xlShiftLeft
'[用途類別]先複製到最右邊倒數第三欄
.Columns("C:C").Select
Selection.Copy
Sheets("工作表2").Columns(.Columns.Count - 2).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
'[用途別]先複製到最右邊倒數第二欄
.Columns("B:B").Select
Selection.Copy
Sheets("工作表2").Columns(.Columns.Count - 1).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
'[工作計畫]先複製到最右邊倒數第一欄
.Columns("A:A").Select
Selection.Copy
Sheets("工作表2").Columns(.Columns.Count).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
'進階不重複篩選--放到...最右邊倒數第四欄
.Columns("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Columns(.Columns.Count - 3), Unique:=True
Application.CutCopyMode = False
a = Sheets("工作表2").Columns(.Columns.Count - 3).End(xlDown).Row '查看(科目)有多少個數量
b = .Columns.Count - 3 'b為第幾欄(最右邊倒數第四欄)
'設定--定義範圍
ActiveWorkbook.Names.Add Name:="abc", RefersToR1C1:="=工作表2!R2C" & b & ":R" & a & "C" & b
ActiveWorkbook.Names("abc").Comment = ""
'設定下拉式清單
Sheets("工作表1").Select
Range("C2").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(""abc "")"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
'複製下拉式清單到別格
Selection.AutoFill Destination:=Range("C2:C5"), Type:=xlFillDefault
'設定定義範圍
a = Sheets("工作表2").Columns(.Columns.Count - 2).End(xlDown).Row '查看這張參照表有多少[用途類別]，這張表的底部到多低
b = .Columns.Count - 2 'b為第幾欄(最右邊倒數第三欄...[用途類別])
Sheets("工作表2").Select
ActiveWorkbook.Names.Add Name:="data", RefersToR1C1:="=工作表2!R2C" & b & ":R" & a & "C" & (b + 2) '這個範圍有三欄，從b到b+2
ActiveWorkbook.Names("data").Comment = ""
'設定自動出現-方法2，若對照表中為空格，顯示空格，若工作類別(科目)未選，顯示空格
'(從定義好的範圍data中去找到範圍中的第2欄，放到B2---B2要放用途別，data的第2欄也是用途別)
'先設定[用途別]
Sheets("工作表1").Select
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(IF(VLOOKUP(RC3,data,2,0)=0,"""",VLOOKUP(RC3,data,2,0)),"""")"
'複製公式到別格
Selection.AutoFill Destination:=Range("B2:B5"), Type:=xlFillDefault
'再設定[工作計畫]---A2要放用[工作計畫]，data的第3欄也是[工作計畫])
Sheets("工作表1").Select
Range("A2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(IF(VLOOKUP(RC3,data,3,0)=0,"""",VLOOKUP(RC3,data,3,0)),"""")"
'複製公式到別格
Selection.AutoFill Destination:=Range("A2:A5"), Type:=xlFillDefault
End With
Range("C2").Select
End Sub

複製代碼

自動設下拉式選單.rar (31.51 KB)

感謝各位

哈囉~大家好呀

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

5^#

發表於 2020-5-19 23:32 | 顯示全部帖子

回復 9# n7822123

哇賽~~~龍大你這個太屌了吧
我土炮方法想了好久，繞了好幾圈，才做出這樣的功能
你沒幾行就做完了.....
能否教兩句? 想學...

(有搜尋ByVal Target As Range的用法，但還不是很懂，我們這版之前也有相關主題)
目前看來有兩大重點
1.觸發功能
2.塞字典功能

另外是，我只會插入AXTIVE的按鈕，裡面放程式碼
你那兩個按鈕...好像也不是按鈕，為什麼可以按啊? 真神奇

然後你還有建立了模組跟物件類別模組....
這我以前都沒有用過...

哈囉~大家好呀

帖子: 129
主題: 25
精華: 0
積分: 159
點名: 0
作業系統: win7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2011-12-24
最後登錄: 2022-12-12

6^#

發表於 2020-5-19 23:54 | 顯示全部帖子

本帖最後由 iceandy6150 於 2020-5-19 23:56 編輯

1) 如果表2的C欄都是不重覆的, 那直接用這來設定第三層選單,
又如果資料並不變動或變動少, 則可固定範圍定義名稱,
若時有變動(重點:不重覆), 用動態定義名稱即可解決, 何須每次都要跑VBA迴圈!!!
這樣用FIND就可定位找出前兩層資料~
2) 如果C欄是會重覆的, 那用第三層選單找對應的前兩層, 就不是那麼準確,
何況如果C欄有幾百或上千行, 每次都要從長又長的選單中去選取所要的, 滑鼠滑上滑下__並不太聰明,也容易選錯重來;
再則, 幾百上千行的內容用字典檔擠成字串, 再塞進清單中, 會不會超過文字長度限制???

回復 10# 准提部林

版大您好，關於這次程式需求的部分，我略做說明一下

三層式下拉選單，我有搜尋過網路
有個做法也是要先把類別表，從直的轉成橫的，之後再去做處理
但是因為我也是幫忙同事處理的，怕以後參照表有變動(新增或刪減)，可能同事就不會操作了
所以我要寫一個...按下按鈕就會通通自己完成的檔案

而且A部門的人，參照表也許有15種。但是B部門的人，參照表也許只有12種。C部門的有26種...等等
所以我希望檔案給他們後，他們只要會增減參照表，剩下的，我的按鈕都會幫他們設定好好的，方便使用

參照表的C欄 (用途類別) 應該是絕對不重覆的。
A欄是大分類，所以在表中很多重覆
B欄是中分類，所以有一些重覆，更討厭的是有一些類別還是空的
C欄是小分類，所以應該必定不會重覆，不然帳就會出錯了

然後...為什麼不要做...先A欄下拉式大分類，之後B欄會剩下相對應的分類，最後剩下C欄的分類
正常來講一般比如說在搜尋料件或倉儲，應該是這樣比較快
但是我這邊報帳表，是不能選錯的
比如，A選到3大類，B選3中類，C卻選去1小類---(這樣帳的科目就錯了)

所以，這樣東西是 A的3 那肯定是B的3 肯定是C的3 (就是整個表的第3列的ABC)
本來是很想叫同事在填的時候，乾脆自己跳去Sheet("參照表")，複製ABC看哪一列，再回來貼上值就好
但是又怕他們把參照表弄亂了
只好想出....只要下拉選擇C欄，經過查照功能，自動幫你放入....相對應的A跟B
所以才想出我那個檔案的做法 (很土炮...)

以目前公司的狀況，參照表的C欄，要報帳的科目應該是不會超過30~50樣

感謝版大的熱心教學

哈囉~大家好呀