- 帖子
- 129
- 主題
- 25
- 精華
- 0
- 積分
- 159
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2011-12-24
- 最後登錄
- 2022-12-12
|
8#
發表於 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)
感謝各位 |
|
發表於 2020-5-16 12:21
| 