[已解决]VBA数据有效性下拉列表中出现不该出现的项目

sd3000sd3000

在下拉列表中，有一个项目不应该出现的，怎么纠正？当表2    A列中只有1个日期时就不会出现，为何？ 请老师解释一下 。谢谢！

最佳答案

月排行榜 / 总排行榜

zjdh

2013-3-10 16:12

再加一句
Private Sub Worksheet_Activate()
    Dim Arr
    Dim Dic As Object
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet2")
        Arr = .Range("A3:F" & .Range("A65536").End(xlUp).Row)
    End With
    For I = 1 To UBound(Arr)
       If Arr(I, 1) <> "" Then Dic(Year(Arr(I, 1))) = ""
    Next I
    With [A3].Validation
        .Delete
        If Dic.Count = 0 Then Exit Sub
        .Add Type:=xlValidateList, Formula1:=Join(Dic.Keys, ",")
    End With
End Sub

跳转到最佳答案楼层

zjdh

空值化成年，就是1899。
因为你取的数据是合并单元格，超过1个数据时包含空格。
可作如下修改：
Private Sub Worksheet_Activate()
    Dim Arr
    Dim Dic As Object
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet2")
        Arr = .Range("A3:F" & .Range("A65536").End(xlUp).Row)
    End With
    For I = 1 To UBound(Arr)
       If Arr(I, 1) <> "" Then Dic(Year(Arr(I, 1))) = ""
    Next I
    With [A3].Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=Join(Dic.Keys, ",")
    End With
End Sub

sd3000sd3000

zjdh 发表于 2013-3-10 15:38
空值化成年，就是1899。
因为你取的数据是合并单元格，超过1个数据时包含空格。
可作如下修改：

谢谢。这样的话，表2   A列有数据时是正常的，但当A列无数据时就会出现错误了。有办法解决吗？

zjdh

再加一句
Private Sub Worksheet_Activate()
    Dim Arr
    Dim Dic As Object
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet2")
        Arr = .Range("A3:F" & .Range("A65536").End(xlUp).Row)
    End With
    For I = 1 To UBound(Arr)
       If Arr(I, 1) <> "" Then Dic(Year(Arr(I, 1))) = ""
    Next I
    With [A3].Validation
        .Delete
        If Dic.Count = 0 Then Exit Sub
        .Add Type:=xlValidateList, Formula1:=Join(Dic.Keys, ",")
    End With
End Sub

sd3000sd3000

zjdh 发表于 2013-3-10 16:12
再加一句
Private Sub Worksheet_Activate()
    Dim Arr

谢谢！非常谢谢！

sd3000sd3000

zjdh 发表于 2013-3-10 16:12
再加一句
Private Sub Worksheet_Activate()
    Dim Arr

请麻烦老师看一下发现这个新问题。VBA数据有效性下拉列表新问题

cj0614881204