同时引用两个工作表作为下拉菜单

天虹染厂/众益包

各位老师好，请帮忙看下工作表中的两个代码，怎样才能同时运行不冲突，谢谢！
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   If Intersect([A2], Target) Is Nothing Then Exit Sub

    Dim arr, i&, s

    Dim d As Object

    Set d = CreateObject("scripting.dictionary") '后期字典

    arr = Sheets("客户").Range("A1:A" & Cells(Rows.Count, "A").End(4).Row) '数据来源列

    For i = 2 To UBound(arr)    'D1是标题，从第2行开始遍历数据源，装入字典

        If arr(i, 1) <> "" Then d(arr(i, 1)) = ""

    Next

    s = Join(d.keys, ",")

    With Target.Validation

        .Delete '删掉旧的

        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=s 'S为数据验证的序列来源

    End With

    'Application.SendKeys "%{down}"    '加这个代码，鼠标放上去直接伸出下拉菜单atl+↓直接弹出数据验证下拉列表

    Set d = Nothing '释放字典
End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)


    If Intersect([B2], Target) Is Nothing Then Exit Sub

    Dim brr, k&, j

    Dim a As Object

    Set a = CreateObject("scripting.dictionary") '后期字典

    brr = Sheets("数据库").Range("a1:a" & Cells(Rows.Count, "a ").End(4).Row) '数据来源列

    For i = 2 To UBound(arr)    'D1是标题，从第2行开始遍历数据源，装入字典

        If brr(k, 1) <> "" Then a(brr(k, 1)) = ""

    Next

    j = Join(d.keys, ",")

    With Target.Validation

        .Delete '删掉旧的

        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=j 'S为数据验证的序列来源

    End With

    'Application.SendKeys "%{down}"    '加这个代码，鼠标放上去直接伸出下拉菜单atl+↓直接弹出数据验证下拉列表

    Set a = Nothing '释放字典




End Sub

山菊花

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim nRow%, arr, i&, s, cSh$
    Dim d As Object
    cSh = IIf(Target.Address = "$A$2", "客户", IIf(Target.Address = "$B$2", "数据库", ""))
    If cSh = "" Then Exit Sub
    Set d = CreateObject("scripting.dictionary") '后期字典
    With Sheets(cSh)
        nRow = .Range("a1048576").End(xlUp).Row
        arr = .Range("a1:a" & nRow).Value
    End With
    For i = 2 To nRow    'D1是标题，从第2行开始遍历数据源，装入字典
        If arr(i, 1) <> "" Then d(arr(i, 1)) = ""
    Next
    s = Join(d.keys, ",")
    With Target.Validation
        .Delete '删掉旧的
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=s 'S为数据验证的序列来源
    End With
    'Application.SendKeys "%{down}"    '加这个代码，鼠标放上去直接伸出下拉菜单atl+↓直接弹出数据验证下拉列表
    Set d = Nothing '释放字典
End Sub

liulang0808

做了简单调整，代码还可以进一步的简化，供参考

天虹染厂/众益包

山菊花 发表于 2021-3-31 08:04
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim nRow%, arr, i&, s, cSh$
    D ...

完美解决，衷心感谢！

天虹染厂/众益包

liulang0808 发表于 2021-3-31 08:08
做了简单调整，代码还可以进一步的简化，供参考

好的，我慢慢琢磨下，谢谢！

天虹染厂/众益包

天虹染厂/众益包 发表于 2021-3-31 16:17
好的，我慢慢琢磨下，谢谢！

已经解决，非常感谢！

天虹染厂/众益包

山菊花 发表于 2021-3-31 08:04
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim nRow%, arr, i&, s, cSh$
    D ...

版主，你好，这个代码好像只能对被引用的数据都是同时在A列（对应列），不知我说的对不对，但现在遇到新问题，如果被引用的其中一个工作表，被引用的数据不在A列而在B列应该怎么解决？请版主帮忙看下，谢谢。

山菊花

数据如果在B列，你就引用B列。

天虹染厂/众益包

山菊花 发表于 2021-3-31 17:24
数据如果在B列，你就引用B列。

不好意思，可能我没表达清楚，现在引用的都是A列的，如果一个在工作表的数据在A列，一个在工作表的数据在B列呢？

于箱长

天虹染厂/众益包 发表于 2021-3-31 18:52
不好意思，可能我没表达清楚，现在引用的都是A列的，如果一个在工作表的数据在A列，一个在工作表的数据在 ...

版主的意思是让你参照着改一下