六合开奖结果现场直播欢迎诸位!收藏本站注 册登 陆
常用三肖中特马:基础知识网络知识操作系统WPS网页制作数据库算法网页成功之路网络安全最新技术古典mid流行midmid背景下载中心
您现在的位置:首页 > 三肖中特马 > 文章页

2级动态数据有效性代码示例

Admin | 2012-8-17 6:16:25 | ReadNums | 5006 | 标签 六合开奖结果现场直播 | 打印本页
     

  假设:A列是源名称,中间有空格,B列为各个源名称对应的数目不同的代号,C列是目标名称来源于源名称,要求在C列设置不重复的、没有空格的数据有效性供选择;同时D列目标代号,要求随着C列选择的目标名称的不同,提供对应的代号供选择,是为第2级数据有效性。

  If Target.Count > 1 Then Exit Sub
  If Target.Column <> 4 And Target.Column <> 3 Then Exit Sub
  Dim d, i&, Myr&, Arr, r%, Arr1(), cp$, ks&, js&, j&
  Set d = CreateObject("Scripting.Dictionary")
  Myr =[b65536].End(xlUp).Row
  Arr = Range("a2:b" & Myr)
  If Target.Column = 3 Then
      For i = 1 To UBound(Arr)
          If Arr(i, 1) <> "" Then
              d(Arr(i, 1)) = ""
          End If
      Next
      With Target.Validation
          .Delete
          .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
          Operator:=xlBetween, Formula1:=Join(d.keys, ",")
      End With
      Target.Offset(0, 1) = ""
  ElseIf Target.Column = 4 And Target.Offset(0, -1) <> "" Then
      For i = 1 To UBound(Arr)
          If Arr(i, 1) <> "" Then
              r = r + 1
              ReDim Preserve Arr1(1 To r)
              Arr1(r) = i
          End If
      Next i
      For i = 1 To r
          If Arr(Arr1(i), 1) = Target.Offset(0, -1).Text Then
              If i <> r Then
                  js = Arr1(i + 1) - 1
              Else
                  js = Myr - 1
              End If
              ks = Arr1(i)
              For j = ks To js
                  cp = cp & Arr(j, 2) & ","
              Next
          End If
      Next i
      cp = Left(cp, Len(cp) - 1)
      With Target.Validation
          .Delete
          .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
          Operator:=xlBetween, Formula1:=cp
      End With
      Target = Split(cp, ",")(0)
  End If
  Set d = Nothing
  End Sub

  部分代码解释:

  1、Private Sub Worksheet_SelectionChange(ByVal Target As Range) :本例用的是工作表选择变化事件,只要鼠标点击单元格都会激活这个事件。Private 可译为私有的,限制了这段代码只能在指定的工作表里有效。参数Target声明为单元格区域对象,有了关键字ByVal,说明可以按值传递参数。
  2、If Target.Count > 1 Then Exit Sub  :由于是鼠标点击单元格都会激活这个事件,所以最好要作一些限制,使得你能避免点击了不需要激活事件的地方而激活本事件产生错误。本句是如果目标单元格的数目大于1就退出本过程。这样当你点选了多个单元格的时候,过程运行了这句代码就会结束过程了。
  3、If Target.Column <> 4 And Target.Column <> 3 Then Exit Sub  :再加一个限制,如果目标单元格的列不是3列(C列)也不是4列(D列)的话就退出过程。
  4、接着的四句代码分别是声明变量、创建字典对象、B列最后一个非空单元格的行数以及把单元格区域的值赋给数组变量等等与前面的实例相同。请注意这里选择了B列求最后一个非空单元格的行数,是因为A列各数据之间有空格,如果选择A列,就会遗漏一些数据。
  5、If Target.Column = 3 Then :现在分两种情况判断,如果点击的目标单元格是C列的,那么执行下面的代码。
  6、If Arr(i, 1) <> "" Then :在数组Arr之间逐一循环,如果A列数组的值不等于空,就作为关键字加入字典d。这样就排除了空值进入字典。
  7、With Target.Validation :这里使用了With语句,With语句为我们提供了十分简便的对象引用手段。使用它有3个优点:可以减少代码的输入量、增加代码的可读性。改善代码的执行效率。在End With之前的语句都是对目标单元格的有效性对象的各个属性进行设置。
  8、.Delete :先删除该单元格的数据有效性。注意Delete前有个小圆点,在小圆点之前就省略了Target.Validation,即减少了代码的输入量。这个小圆点不能遗漏,否则会出错。
  9、.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=Join(d.keys, ",") :Add是有效性对象的方法,向指定区域内添加数据有效性检验。参数Type是数据有效性类型,当类型等于xlValidateList时,后面的公式1参数Formula1 必须包含以逗号分隔的取值列表。参数AlertStyle是出错警告样式,这里是停止样式;参数Operator是数据有效性运算符,有大于、小于、大于或等于、小于或等于、介于、不介于、等于、不等于等等,这里取介于;公式1参数Formula1的值用了VBA函数Join,把字典的关键字用逗号分隔后连接起来赋给公式1参数。这样,目标单元格那的数据有效性中就没有重复值了。
  10、Target.Offset(0, 1) = "" :给目标单元格设置了数据有效性以后,把它同行D列单元格的值清除。这是为了确保D列的值只与C列的目标名称相对应。
  11、ElseIf Target.Column = 4 And Target.Offset(0, -1) <> "" Then :否则如果目标单元格是D列的,并且同行C列单元格不是空的情况下,执行这下面的代码。Offset属性的详解可见前面实例6的第2条解释。
  12、For i = 1 To UBound(Arr) :在数组Arr之间逐一循环。
  13、If Arr(i, 1) <> "" Then :如果A列数组的值不等于空,就执行下面的代码。
  14、r = r + 1 :变量r累加。
  15、ReDim Preserve Arr1(1 To r) :重新声明动态数组的大小,Preserve是关键字,当改变原有数组最末维的大小时,使用此关键字可以保持数组中原来的数据。这句是改变动态数组大小的最常用语句,不能忘记Preserve关键字。
  16、Arr1(r) = i :把关键字在数组Arr中行的位置赋给新的动态数组Arr1(r)。这个循环可求得A列每一个源名称所在的行的位置。
  17、For i = 1 To r :上面的循环求得了一共有r个源名称,逐一循环。
  18、If Arr(Arr1(i), 1) = Target.Offset(0, -1).Text Then :如果C列的目标名称等于源名称时执行下面的代码。
  19、If i <> r Then :如果i不等于r时执行下面的代码。
  20、js = Arr1(i + 1) – 1 :把下一个源名称所在的行数-1以后赋给变量js,这样来求得每一个源名称的开始和结束的位置。
  21、js = Myr – 1 :否则就是最后一行-1的只赋给变量js(最后一个源名称在数组中的位置)。
  22、ks = Arr1(i) :把数组的值赋给变量ks:得到每一个源名称的起始位置。
  23、For j = ks To js :从每一个源名称的起始位置到结束位置逐一循环。
  24、cp = cp & Arr(j, 2) & "," :把相应的代号与逗号连接起来组成的字符串赋给变量cp。
  25、cp = Left(cp, Len(cp) - 1) :用了两个VBA函数Left和Len把去掉末位的逗号。
  26、With 语句解释同上,为D列单元格设置了第2级数据有效性。
  27、Target = Split(cp, ",")(0) :按照问题的第3个要求,在目标名称确定后,在目标代号相应位置自动生成目标名称的第一个代号。因为Split得到的是一个以0为下界的一维函数,所以它的第一个元素就用(0)来表示。


问题未解决:在线咨询

网友评论

(访客)
内容实用原创,讲得很好。
20xx年x月x日
(站长)
有问题请在线咨询。
20xx年x月x日