有关【二义性】错误， Private Sub Worksheet_SelectionChange(ByVal Target As Ra...

maple@daisy

求助大神，台账表格里设置有多级下拉菜单，此外还有联想输入下拉列表。两个代码能否合并同时使用，万分感谢。 附多级下拉代码： Private Sub Worksheet_SelectionChange(ByVal Target As Range)     Dim a(), i     On Error Resume Next     If Target.Count = 1 Then         If Target.Column = 3 Then             With Application.CommandBars("myCell")                 .ShowPopup         End With         ElseIf Target.Column <= 5 And Target.Column >= 4 Then             ReDim a(0 To Target.Column - 2)             For i = 2 To Target.Column                 If Cells(Target.Row, i - 1) <> "" Then                     a(i - 2) = Cells(Target.Row, i - 1)                 End If             Next             Call SubPopBar(a)         End If     End If End Sub 联想输入的代码： Option Explicit Dim selRng As Range, Arr Private Sub Worksheet_SelectionChange(ByVal Target As Range)     Me.lstIn.Visible = False     Me.txtIn.Visible = False     Arr = Sheet3.Range("A1").CurrentRegion     If Target.Count = 1 Then         If Target.Column = 6 And Target.Row > 1 Then             Set selRng = Target             With Me.txtIn                 .Text = ""                 .Top = Target.Top                 .Left = Target.Left                 .Width = Target.Width                 .Height = Target.Height + 2                 .Visible = True                 .Activate             End With             With Me.lstIn                 .Top = selRng.Top + selRng.Height                 .Left = selRng.Offset(0, 1).Left                 .Width = selRng.Width                 .Height = selRng.Height * 5                 .Visible = True             End With         End If     End If End Sub Private Sub txtIn_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)     Dim i As Integer     Me.lstIn.Clear     If txtIn.Value <> "" Then         For i = 2 To UBound(Arr, 1)             If InStr(1, Arr(i, 1), txtIn.Value, 1) > 0 Then                 Me.lstIn.AddItem Arr(i, 1)             End If         Next i     Else         For i = 2 To UBound(Arr)             Me.lstIn.AddItem Arr(i, 1)         Next i     End If End Sub Private Sub lstIn_DblClick(ByVal Cancel As MSForms.ReturnBoolean)    selRng.Value = lstIn.Value     Me.lstIn.Clear     Me.txtIn = ""     Me.lstIn.Visible = False     Me.txtIn.Visible = False End Sub

hfwufanhf2006

代码里有两段 _selectionchange代码，内容还不一样。
只能有一个同名称的事件过程，要么合并要么删除其中一个

大灰狼1976

下载不了附件（网络限制，我这边的问题），没测试。

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim a(), i
   
3.     On Error Resume Next
   
4.     If Target.Count = 1 Then
   
5.         If Target.Column = 3 Then
   
6.             With Application.CommandBars("myCell")
   
7.                 .ShowPopup
   
8.             End With
   
9.         ElseIf Target.Column <= 5 And Target.Column >= 4 Then
   
10.             ReDim a(0 To Target.Column - 2)
    
11.             For i = 2 To Target.Column
    
12.                 If Cells(Target.Row, i - 1) <> "" Then
    
13.                     a(i - 2) = Cells(Target.Row, i - 1)
    
14.                 End If
    
15.             Next
    
16.             Call SubPopBar(a)
    
17.         ElseIf Target.Column = 6 And Target.Row > 1 Then
    
18.             Me.lstIn.Visible = False
    
19.             Me.txtIn.Visible = False
    
20.             Set selRng = Target
    
21.             With Me.txtIn
    
22.                 .Text = ""
    
23.                 .Top = Target.Top
    
24.                 .Left = Target.Left
    
25.                 .Width = Target.Width
    
26.                 .Height = Target.Height + 2
    
27.                 .Visible = True
    
28.                 .Activate
    
29.             End With
    
30.             With Me.lstIn
    
31.                 .Top = selRng.Top + selRng.Height
    
32.                 .Left = selRng.Offset(0, 1).Left
    
33.                 .Width = selRng.Width
    
34.                 .Height = selRng.Height * 5
    
35.                 .Visible = True
    
36.             End With
    
37.         End If
    
38.     End If
    
39. End Sub

复制代码