先不重複篩選後，並自動設為下拉式選單 - Excel程式區

1 23

返回列表下一主題上一主題發帖

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

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

自己試試吧!

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

複製代碼

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

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

TOP

iceandy6150

中學生 Rank: 2

帖子: 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又保持乾淨空的狀態


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

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欄)，會自動放入....公司業務

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

哈囉~大家好呀

TOP

准提部林