返回列表 上一主題 發帖

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

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

大家好,小弟目前有一工作表要填寫,如圖1
1-1.jpg
2020-5-16 00:03

也就是工作表1的第G、H、I欄
而填寫內容必須參照工作表2的表格,如圖2
2-1.jpg
2020-5-16 00:06


如果[用途類別(科目)]是--物品/消耗品
則[用途別] 必定是--業務費
且[工作計畫] 也必定是--公司業務

其實準則在[用途類別(科目)]

我的想法是
既然工作表1的第G、H、I欄,要慢慢打字,能否設定下拉式選單
而選單的內容值,是從工作表2去不重複篩選
這樣就可以用下拉式去選,不必打字
不重複篩選後如圖3
3.JPG
2020-5-16 00:13


當我在工作表1按下按鈕後
會自動把工作表1的G欄,設定下拉式清單,一次50列,來源是工作表2的F
會自動把工作表1的H欄,設定下拉式清單,一次50列,來源是工作表2的G
會自動把工作表1的I欄,設定下拉式清單,一次50列,來源是工作表2的H

但是,工作表2的這個表格,是隨時有可能增減的
每一次執行,都要能重新判斷,並把舊的篩選結果移除



【第二個自動化完美做法】
就是既然準則在[用途類別(科目)] --(工作表1的I欄)
那按下按鈕後
會自動把工作表1的I欄,設定下拉式清單,一次50列,來源是工作表2的H
然後I欄下拉選定某個值後
會自動把工作表1的H欄,填入工作表2對照表格中相對應的值
會自動把工作表1的G欄,填入工作表2對照表格中相對應的值
(連動的概念)


不論做法一 或 做法二(完美法)
我用錄製巨集的方式找出 不重複進階篩選並複製貼上到別的地方 的寫法
可是要讓那個範圍,設定為下拉式選單的參照範圍,尤其可能又是動態的
我一直搞不定
求助各位大大了,感謝

附上檔案
自動設下拉式選單.rar (23.9 KB)
哈囉~大家好呀

利用"定義名稱"動態下拉清單:
Xl0000170(三層下拉清單).rar (17.81 KB)
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 2# 准提部林

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

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

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

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

現在目標有幾個
目前可以做到按下按鈕,就自動把篩選不重複後的東西,貼到某欄
但是可能現在篩選後有四種,但是參照表以後修改,可能篩選後會變六種
  1. With Sheets("工作表2")
  2.   .UsedRange.Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("工作表2").Range( _
  3.         "F1"), Unique:=True
  4. Set Rng =.Range("F1").CurrentRegion
  5. End With
複製代碼
<目標一>如何讓程式判斷,現在{清單}的[用途類別(科目)]..篩選後有幾種
<目標二>判斷有幾種後,將這個..幾種類別...設定給....工作表1的...[用途類別]那一欄...的下拉式選單
  1. Range("I1").Select
  2. With Selection.Validation
  3.     .Delete
  4.     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
  5.     xlBetween, Formula1:=Sheets("工作表2").Rng   '"=工作表2!$C$2:$C$7"
  6.     .IgnoreBlank = True
  7.     .InCellDropdown = True
  8.     .InputTitle = ""
  9.     .ErrorTitle = ""
  10.     .InputMessage = ""
  11.     .ErrorMessage = ""
  12.     .IMEMode = xlIMEModeNoControl
  13.     .ShowInput = True
  14.     .ShowError = True
  15. End With
複製代碼
設定來源那邊有問題  Formula1:=

<目標三>自動設定50列都有下拉式選單
  1. Selection.AutoFill Destination:=Range("I1:I50"), Type:=xlFillDefault
複製代碼
<遠程目標>
若是目標一二都能達成,則   [用途類別] 的下拉選擇某一類後, [工作計畫]跟[用途別]可能自動產生相對應的值出來 (能參考{清單}中的表
例如:
[用途類別](I欄) 的下拉選擇......離職儲金   之後
那麼
[用途別](H欄),會自動放入.....人事費
[工作計畫](G欄),會自動放入....公司業務

如果程式有辦法做到的話
再麻煩版主及其他大大協助指點,謝謝
哈囉~大家好呀

TOP

回復 1# iceandy6150


自己試試吧!
  1. Sub 下拉選單()

  2. '工作表2的A欄
  3. Arr = Range([工作表2!A2], [工作表2!A65535].End(3))
  4. List$ = ""
  5. For R = 1 To UBound(Arr)  '去除重複
  6.   If InStr(List, Arr(R, 1)) = 0 Then List = List & "," & Arr(R, 1)
  7. Next
  8. With [G2:G100].Validation  '下拉格式的範圍自己改
  9.   .Delete
  10.   .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=List
  11. End With

  12. '工作表2的B欄
  13. Arr = Range([工作表2!B2], [工作表2!B65535].End(3))
  14. List = ""
  15. For R = 1 To UBound(Arr)  '去除重複
  16.   If InStr(List, Arr(R, 1)) = 0 Then List = List & "," & Arr(R, 1)
  17. Next
  18. With [H2:H100].Validation  '下拉格式的範圍自己改
  19.   .Delete
  20.   .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=List
  21. End With

  22. '工作表2的C欄
  23. Arr = Range([工作表2!C2], [工作表2!C65535].End(3))
  24. List = ""
  25. For R = 1 To UBound(Arr)  '去除重複
  26.   If InStr(List, Arr(R, 1)) = 0 Then List = List & "," & Arr(R, 1)
  27. Next
  28. With [I2:I100].Validation  '下拉格式的範圍自己改
  29.   .Delete
  30.   .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=List
  31. End With
  32. End Sub
複製代碼
自動設下拉式選單0518.rar (25.74 KB)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 4# n7822123


   
原寫法有瑕疵,未考慮項目可能有互相包含的字串

修正如下 (紅色部分)



Sub 下拉選單()

'工作表2的A欄
Arr = Range([工作表2!A2], [工作表2!A65535].End(3))
List$ = ""
For R = 1 To UBound(Arr)  '去除重複
  If InStr("," & List & ",", "," & Arr(R, 1) & ",") = 0 Then List = List & "," & Arr(R, 1)
Next
With [G2:G100].Validation  '下拉格式的範圍自己改
  .Delete
  .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=List
End With

'工作表2的B欄
Arr = Range([工作表2!B2], [工作表2!B65535].End(3))
List = ""
For R = 1 To UBound(Arr)  '去除重複
  If InStr("," & List & ",", "," & Arr(R, 1) & ",") = 0 Then List = List & "," & Arr(R, 1)
Next
With [H2:H100].Validation  '下拉格式的範圍自己改
  .Delete
  .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=List
End With

'工作表2的C欄
Arr = Range([工作表2!C2], [工作表2!C65535].End(3))
List = ""
For R = 1 To UBound(Arr)  '去除重複
  If InStr("," & List & ",", "," & Arr(R, 1) & ",") = 0 Then List = List & "," & Arr(R, 1)
Next
With [I2:I100].Validation  '下拉格式的範圍自己改
  .Delete
  .Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=List
End With

End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 3# iceandy6150


想用第三層選單, 往回推算前兩層相關聯文字, 再自動填入???
問題:第三層選單所對應的有兩個以上, 如何判斷屬于哪一個???

2樓給的是漸進式的動態選單, 選第一層後, 自動判斷第二層清單, 再至第三層,
越選越少, 也不須打字!!!

至于表1, 可預建1~200列驗證清單,
輸入完成-轉出後, 用CLEARCONTENTS清空內容, 即可繼續輸入新的資料,
幾行程式碼即可~~

=========================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 5# n7822123

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

TOP

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

回復 6# 准提部林

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

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

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

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

以下是程式碼
跟測試檔案
(目前自動產生下拉清單只設定5格)
  1. Private Sub CommandButton1_Click()
  2.     Range("A2:C20").Select
  3.     Selection.ClearContents
  4.     With Selection.Validation
  5.         .Delete
  6.         .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
  7.         :=xlBetween
  8.         .IgnoreBlank = True
  9.         .InCellDropdown = True
  10.         .IMEMode = xlIMEModeNoControl
  11.         .ShowInput = True
  12.         .ShowError = True
  13.     End With
  14.    
  15.     Range("C2").Select
  16.    
  17. End Sub


  18. '*******************************************************************************


  19. Private Sub CommandButton2_Click()
  20. Dim a, b, c, d

  21. Sheets("工作表2").Select

  22. With Sheets("工作表2")

  23.     '每次執行先將最右邊四欄砍光
  24.     .Columns(.Columns.Count).Delete Shift:=xlShiftLeft
  25.     .Columns(.Columns.Count - 1).Delete Shift:=xlShiftLeft
  26.     .Columns(.Columns.Count - 2).Delete Shift:=xlShiftLeft
  27.     .Columns(.Columns.Count - 3).Delete Shift:=xlShiftLeft


  28.     '[用途類別]先複製到最右邊倒數第三欄
  29.     .Columns("C:C").Select
  30.     Selection.Copy
  31.     Sheets("工作表2").Columns(.Columns.Count - 2).PasteSpecial (xlPasteAll)
  32.     Application.CutCopyMode = False


  33.     '[用途別]先複製到最右邊倒數第二欄
  34.     .Columns("B:B").Select
  35.     Selection.Copy
  36.     Sheets("工作表2").Columns(.Columns.Count - 1).PasteSpecial (xlPasteAll)
  37.     Application.CutCopyMode = False
  38.    
  39.    
  40.     '[工作計畫]先複製到最右邊倒數第一欄
  41.     .Columns("A:A").Select
  42.     Selection.Copy
  43.     Sheets("工作表2").Columns(.Columns.Count).PasteSpecial (xlPasteAll)
  44.     Application.CutCopyMode = False
  45.    

  46.     '進階不重複篩選--放到...最右邊倒數第四欄
  47.     .Columns("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Columns(.Columns.Count - 3), Unique:=True
  48.      Application.CutCopyMode = False
  49.      
  50.     a = Sheets("工作表2").Columns(.Columns.Count - 3).End(xlDown).Row '查看(科目)有多少個數量
  51.     b = .Columns.Count - 3 'b為第幾欄(最右邊倒數第四欄)
  52.      
  53.      
  54.     '設定--定義範圍
  55.     ActiveWorkbook.Names.Add Name:="abc", RefersToR1C1:="=工作表2!R2C" & b & ":R" & a & "C" & b
  56.     ActiveWorkbook.Names("abc").Comment = ""
  57.      
  58.      
  59.     '設定下拉式清單
  60.     Sheets("工作表1").Select

  61.         Range("C2").Select
  62.         With Selection.Validation
  63.             .Delete
  64.             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
  65.             xlBetween, Formula1:="=INDIRECT(""abc "")"
  66.             .IgnoreBlank = True
  67.             .InCellDropdown = True
  68.             .InputTitle = ""
  69.             .ErrorTitle = ""
  70.             .InputMessage = ""
  71.             .ErrorMessage = ""
  72.             .IMEMode = xlIMEModeNoControl
  73.             .ShowInput = True
  74.             .ShowError = True
  75.         End With

  76.     '複製下拉式清單到別格
  77.      Selection.AutoFill Destination:=Range("C2:C5"), Type:=xlFillDefault


  78.     '設定 定義範圍
  79.      a = Sheets("工作表2").Columns(.Columns.Count - 2).End(xlDown).Row  '查看這張參照表有多少[用途類別],這張表的底部到多低
  80.      b = .Columns.Count - 2 'b為第幾欄(最右邊倒數第三欄...[用途類別])
  81.    
  82.         Sheets("工作表2").Select
  83.         ActiveWorkbook.Names.Add Name:="data", RefersToR1C1:="=工作表2!R2C" & b & ":R" & a & "C" & (b + 2)  '這個範圍有三欄,從b到b+2
  84.         ActiveWorkbook.Names("data").Comment = ""

  85.     '設定自動出現-方法2,若對照表中為空格,顯示空格,若工作類別(科目)未選,顯示空格
  86.      '(從定義好的範圍data中去找到範圍中的第2欄,放到B2---B2要放用途別,data的第2欄也是用途別)
  87.      
  88.      '先設定[用途別]
  89.          Sheets("工作表1").Select
  90.          Range("B2").Select
  91.          ActiveCell.FormulaR1C1 = _
  92.              "=IFERROR(IF(VLOOKUP(RC3,data,2,0)=0,"""",VLOOKUP(RC3,data,2,0)),"""")"
  93.         '複製公式到別格
  94.          Selection.AutoFill Destination:=Range("B2:B5"), Type:=xlFillDefault
  95.         
  96.       '再設定[工作計畫]---A2要放用[工作計畫],data的第3欄也是[工作計畫])
  97.          Sheets("工作表1").Select
  98.          Range("A2").Select
  99.          ActiveCell.FormulaR1C1 = _
  100.              "=IFERROR(IF(VLOOKUP(RC3,data,3,0)=0,"""",VLOOKUP(RC3,data,3,0)),"""")"
  101.         '複製公式到別格
  102.          Selection.AutoFill Destination:=Range("A2:A5"), Type:=xlFillDefault
  103.         
  104. End With

  105. Range("C2").Select


  106. End Sub
複製代碼
自動設下拉式選單.rar (31.51 KB)

感謝各位
哈囉~大家好呀

TOP

本帖最後由 n7822123 於 2020-5-19 11:17 編輯

回復 1# iceandy6150

【第二個自動化完美做法】
就是既然準則在[用途類別(科目)] --(工作表1的I欄)
那按下按鈕後
會自動把工作表1的I欄,設定下拉式清單,一次50列,來源是工作表2的H
然後I欄下拉選定某個值後
會自動把工作表1的H欄,填入工作表2對照表格中相對應的值
會自動把工作表1的G欄,填入工作表2對照表格中相對應的值
(連動的概念)


原來你的需求只是這麼簡單~ 10分鐘搞定
這我常常幫公司的同事做
不需命名名稱、不用函數
看你有沒有心想學別人的做法



xls版本是給舊版Excel的人使用的,
2007以後請開xlsm版本


自動設下拉式選單0519.rar (46.43 KB)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

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

TOP

        靜思自在 : 時時好心就是時時好日。
返回列表 上一主題