列表框显示不在范围内的日期

Question

我的列表框出了问题。当我第一次运行以下代码时，它始终只显示1个日期 30/12/1899 。我指定的范围仅包含6个日期 8/1 / 2014,9 / 1 / 2014,14 / 1 / 2014,24 / 1 / 2014,24 / 1/2014和02/02 / 2014 。 一旦我停止表格并再次运行，所有必需的日期都会出现。

我刚刚开始在Excel上学习VBA，所以我仍然在努力理解这些概念。 有什么东西我不见了吗？没有重复的原因是我无法显示2个日期（2014年1月24日）。

Private Sub UserForm_Activate()

    Dim AllCells As Range, Cell As Range
    Dim NoDupes As New Collection
    Dim i As Integer, j As Integer
    Dim Swap1, Swap2, Item
    Dim wksJobDetail As Worksheet

'The items are in A2:A7
    Set AllCells = Range("A2:A7")

'Point the variable to JobSchedule worksheet
    Set wksJobDetail = Application.Workbooks("xxxxx.xlsm").Worksheets("JobSchedule")
    wksJobDetail.Activate

'Statement ignores any errors regarding duplicates and duplicate dates aren't added
    On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Format(CDate(Cell.Value), "dd/mm/yyyy"), _
            CStr(Format(CDate(Cell.Value), "dd/mm/yyyy"))
    Next Cell

'Add non-duplicated items into lstDate
    For Each Item In NoDupes
        JobDetail.lstDate.AddItem Item
    Next Item
End Sub

Answer 1

Set AllCells = Range("A2:A7")将引用有效工作表，该工作表可能是wksJobDetail，也可能不是。{/ p>

第二次运行时，wksJobDetail已被激活。

尝试将Set AllCells = Range("A2:A7")语句放在：

之后

设置wksJobDetail = Application.Workbooks（“xxxxx.xlsm”）。工作表（“JobSchedule”） wksJobDetail.Activate

Answer 2

我认为这与您在Excel中格式化数据的方式以及引用源范围的正确方法有关。

试试这个： 首先，检查日期是否在Excel中正确输入日期，如下所示。

然后明确这一行：

Set AllCells = Range("A2:A7")

并改为：

Set AllCells = Sheets("JobSchedule").Range("A2:A7") 

现在，运行我在下面添加 On Error Goto 0 时重写的代码。

Dim AllCells As Range, Cell As Range, Item
Dim NoDupes As New Collection

Set AllCells = Sheets("JobSchedule").Range("A2:A7")

On Error Resume Next '~~> Ignore Error starting here
For Each Cell In AllCells
    NoDupes.Add Format(CDate(Cell.Value), "dd/mm/yyyy"), _
        CStr(Format(CDate(Cell.Value), "dd/mm/yyyy"))
Next Cell
On Error GoTo 0 '~~> Stops ignoring error

For Each Item In NoDupes
    JobDetail.lstDate.AddItem Item
Next Item

这应该会给你想要的结果。另外，我建议使用初始化事件而不是激活 每次使用 OERN 时，请不要忘记使用OEG0重置错误处理 否则，您将无法捕获与集合中添加现有项目无关的其他错误。

<强>加成：

另一种方法是使用 Dictionary 代替。您需要添加对 Microsoft Scripting Runtime 的引用。我重写了部分代码，它们具有相同的效果。 Dictionary 的优点是它提供了您可以使用的其他有用属性。

Private Sub UserForm_Initialize()
    Dim AllCells As Range, Cell As Range
    Dim d As Dictionary

    Set AllCells = Sheets("Sheet1").Range("A2:A7")
    Set d = New Dictionary

    For Each Cell In AllCells
        d.Item(Format(CDate(Cell.Value), "dd/mm/yyyy")) = _
            CStr(Format(CDate(Cell.Value), "dd/mm/yyyy"))
    Next Cell
    JobDetail.lstDate.List = d.Keys
End Sub

如您所见，我们使用 Keys 属性移除了一个循环，该属性是所有唯一键的数组。我希望这能有所帮助。