求助，如何用vba给单元格设置数据有效性下拉列表

YZC51

elaine1994 发表于 2020-6-22 22:29
能解释一下吗，有点看不懂

谢谢17楼老师的代码。谢谢老师！

1. Private Sub Worksheet_Change(ByVal T As Range)                                  '私有的子程序 工作表_Change(变量T为 单元格区域)
   
2.     If T.Row = 9 And T.Column = 2 Then                                          '如果  T的行标=9并且  T的列标=2则执行
   
3.         Set Rng = Sheets("数据").Columns(1).Find(T.Value, , , 1)                '设定Rng=<工作表>"数据" )的<列>坐标1 )的<查找> T的值,,,1)
   
4.         If Not Rng Is Nothing Then                                              '如果 非 Rng是 空值则执行
   
5.             r = Rng.Row                                                         'r= Rng的行标
   
6.             ar = Sheets("数据").Range("b" & r & ":g" & r)                       'ar=<工作表>"数据" )的<单元格区域>"b" & r & ":g"& r)
   
7.             For j = 1 To UBound(ar, 2)                                          '设定变量范围为j=1到<数组上限>ar,2)
   
8.                 If Trim(ar(1, j)) <> "" Then                                    '如果 <消除字符串两端空格>ar(1,j))不等于 空值则执行
   
9.                     If s = "" Then                                              '如果 s=空值则执行
   
10.                         s = ar(1, j)                                            's=ar(1,j)
    
11.                     Else                                                        '否则
    
12.                         s = s & "," & ar(1, j)                                  's=s& "," & ar(1,j)
    
13.                     End If                                                      'If判断过程结束
    
14.                 End If                                                          'If判断过程结束
    
15.             Next j                                                              '下一个j
    
16.             With Range("e9").Validation                                         '工作于<单元格区域>"e9" )的Validation
    
17.                 .Delete                                                         '<With对象>的删除
    
18.                 .Add 3, 1, 1, Formula1:=s                                       '<With对象>的添加 3,1,1,公式1=s
    
19.             End With                                                            'With语句结束
    
20.             T.Offset(, 2).Select                                                ' T的<偏移>,2 )的选定
    
21.             T.Offset(, 2) = ar(1, 1)                                            ' T的<偏移>,2)=ar(1,1)
    
22.         End If                                                                  'If判断过程结束
    
23.     End If                                                                      'If判断过程结束
    
24. End Sub                                                                         '子程序结束

复制代码