- 帖子
- 406
- 主題
- 8
- 精華
- 0
- 積分
- 453
- 點名
- 0
- 作業系統
- WINDOWS 7
- 軟體版本
- 2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2015-2-7
- 最後登錄
- 2021-7-31
|
回復 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 |
|
發表於 2020-5-18 05:05
| 
