123
返回列表 上一主題 發帖

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

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
4# 跳轉到 »
發表於 2020-5-18 05:05 | 只看該作者
回復 1# iceandy6150


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

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

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

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

TOP

iceandy6150

帖子
129 
主題
25 
精華
0 
積分
159 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
註冊時間
2011-12-24 
最後登錄
2022-12-12 
3#
發表於 2020-5-17 13:18 | 只看該作者
回復 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

准提部林

帖子
2808 
主題
10 
精華
0 
積分
2864 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-5-10 
2#
發表於 2020-5-16 12:21 | 只看該作者
利用"定義名稱"動態下拉清單:
Xl0000170(三層下拉清單).rar (17.81 KB)

TOP

        靜思自在 : 靜坐常恩己過、閒談莫論人非。
123
返回列表 上一主題