怎么合并2个单元格列的下拉菜单多选

lisoncao112

本人VBA菜鸟，在网上寻到一个下拉菜单多选的VBA代码，只能做到一列单元格出现下拉选项。如果要另一列单元格也实现下拉选项好像就不行，是不是

Private Sub Worksheet_SelectionChange(ByVal Target As Range在一个worksheet只能运用一次？能不能合并，怎么合并谢谢！！

附件已经为2个下拉选项写好了代码，但不知道怎么合并，需要一个worksheet同时实现下拉多选。。谢谢大家！！！
第一个Blue，第二个Green

1. Private Sub ListBoxRS_Change()
   
2. Dim LR As Long
   
3. Dim STR As String
   
4. 
   
5. With ListBoxRS
   
6.     For LR = 0 To .ListCount - 1
   
7.         If .Selected(LR) = True Then
   
8.             STR = STR & "," & .List(LR, 0)
   
9.         End If
   
10.     Next
    
11. End With
    
12. ActiveCell.Value = Mid(STR, 2)
    
13. End Sub
    
14. 
    
15. 
    
16. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
17. If Target.Count > 1 Then ListBoxRS.Visible = False: Exit Sub
    
18. If Target.Column = 1 Then ListBoxRS.Visible = False: Exit Sub
    
19. If Target.Column <> 7 Or Target.Row < 3 Or Target.Offset(0, -1) = "" _
    
20. Then ListBoxRS.Visible = False: Exit Sub
    
21. 
    
22. Dim RG
    
23. Dim LR As Long
    
24. LR = Sheet2.Range("A9999").End(xlUp).Row
    
25. RG = Sheet2.Range("A1:A" & LR)
    
26. 
    
27. With ListBoxRS
    
28.     .Top = Target.Top
    
29.     .Left = Target.Offset(0, 1).Left
    
30.     .Width = 310
    
31.     .Height = 60
    
32.     .Visible = True
    
33.     .ColumnCount = 1
    
34.     .ColumnWidths = "50;80"
    
35.     .List = RG
    
36. End With
    
37. End Sub
    

复制代码

1. Private Sub ListBoxFT_Change()
   
2. Dim LR As Long
   
3. Dim STR As String
   
4. 
   
5. With ListBoxFT
   
6.     For LR = 0 To .ListCount - 1
   
7.         If .Selected(LR) = True Then
   
8.             STR = STR & "," & .List(LR, 0)
   
9.         End If
   
10.     Next
    
11. End With
    
12. ActiveCell.Value = Mid(STR, 2)
    
13. End Sub
    
14. 
    
15. 
    
16. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
17. If Target.Count > 1 Then ListBoxFT.Visible = False: Exit Sub
    
18. If Target.Column = 1 Then ListBoxFT.Visible = False: Exit Sub
    
19. If Target.Column <> 20 Or Target.Row < 3 Or Target.Offset(0, -1) = "" _
    
20. Then ListBoxFT.Visible = False: Exit Sub
    
21. 
    
22. Dim RG
    
23. Dim LR As Long
    
24. LR = Sheet2.Range("B9999").End(xlUp).Row
    
25. RG = Sheet2.Range("B1:B" & LR)
    
26. 
    
27. With ListBoxFT
    
28.     .Top = Target.Top
    
29.     .Left = Target.Offset(0, 1).Left
    
30.     .Width = 310
    
31.     .Height = 60
    
32.     .Visible = True
    
33.     .ColumnCount = 1
    
34.     .ColumnWidths = "50;80"
    
35.     .List = RG
    
36. End With
    
37. End Sub
    
38. 
    
39. 
    

复制代码

蓝桥玄霜

代码合并：

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. If Target.Count > 1 Then ListBoxFT.Visible = False: Exit Sub
   
3. If Target.Column = 1 Then ListBoxFT.Visible = False: Exit Sub
   
4. If Target.Row < 3 Or Target.Offset(0, -1) = "" _
   
5. Then ListBoxFT.Visible = False: Exit Sub
   
6. If Target.Column <> 20 And Target.Column <> 7 Then ListBoxFT.Visible = False: Exit Sub
   
7. Dim RG
   
8. Dim LR As Long
   
9. LR = Sheet2.Range("B9999").End(xlUp).Row
   
10. RG = Sheet2.Range("B1:B" & LR)
    
11. 
    
12. With ListBoxFT
    
13.     .Top = Target.Top
    
14.     .Left = Target.Offset(0, 1).Left
    
15.     .Width = 310
    
16.     .Height = 60
    
17.     .Visible = True
    
18.     .ColumnCount = 1
    
19.     .ColumnWidths = "50;80"
    
20.     .List = RG
    
21. End With
    
22. End Sub
    

复制代码

另外列表框事件应改为双击事件。