在VBA代码中，如何通过定义范围End（XlDown）的每个单元格方法将值添加到列表框？

Question

我已经创建了带有Forms和Word to Excel的宏文件。

按照我的期望，在这种编码中几乎没有任何工作。

1. 从Excel数据库获取唯一的员工姓名。我想从Excel数据库中添加唯一的员工姓名，并将get保存在工作表中。之后，将这些值添加到列表框中。在这里，我无法定义“ A1：A10”之类的范围。我想从A1中选择数据作为结束数据。

如果对于每个单元格方法均行不通，请在方法时提供帮助

我需要帮助来定义下面给出的范围和代码

ListEmployeeName.Clear
For Each cell In Worksheets("SunEmployeeDetails").Range("A1").End(xlDown)
    ListEmployeeName.AddItem (cell.Value)
Next
    ListEmployeeName.Value = Worksheets("SunEmployeeDetails").Range("A1")
End Sub

Answer 1

找到Last Row，然后定义范围Range("A1:A" & LastRow)

您还可以找到最后一行，并使用For循环在范围内循环。同样，要获得唯一的员工姓名，您可以将On Error Resume Next与Collection结合使用，如下所示。我在下面的代码中添加了注释，因此您在理解它时应该没有问题。但是，如果您这样做，则只需询问即可。

这是您要尝试的吗？ （未经测试。

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim col As New Collection
    Dim itm As Variant

    Set ws = Worksheets("SunEmployeeDetails")

    With ws
        '~~> Find Last row
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Loop through the range and add it to the unique
        '~~> collection using "On Error Resume Next"
        For i = 1 To lRow
            On Error Resume Next
            col.Add .Range("A" & i).Value, CStr(.Range("A" & i).Value)
            On Error GoTo 0
        Next i
    End With

    ListEmployeeName.Clear

    '~~> add the itme from collection to the listbox
    For Each itm In col
        ListEmployeeName.AddItem itm
    Next itm
End Sub

Answer 2

这是我的观点，技术取自here：

---

_{方法1：使用字典}

Dim lr As Long, x As Long
Dim arr As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Sheet1 'Change accordingly

    'Find the last used row
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A1:A" & lr).Value

End With

'Loop through memory and fill dictionary
For x = LBound(arr) To UBound(arr)
    dict(arr(x, 1)) = 1
Next x

'Add array to Listbox
Me.ListEmployeeName.List = dict.Keys

---

_{方法2：使用评估}

Dim lr As Long
Dim arr As Variant

With Sheet1 'Change accordingly

    'Find the last used row
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row

    'Get array of unique values
    arr = Filter(.Evaluate("TRANSPOSE(If(Row(A1:A" & lr & ")<>MATCH(A1:A" & lr & ",A1:A" & lr & ",0),""|"",A1:A" & lr & "))"), "|", False)

    'Add array to Listbox
    Me.ListEmployeeName.List = arr

End With