代码之家 › 专栏 › 技术社区 › Shiela

从excel工作表到列表框显示具有其他列的唯一值

unique listbox forms vba excel

-1

Shiela · 技术社区 · 3 年前

我这里有数据,我想获得列C=项目ID的唯一值。

Date      || Project ID || Implementation Area  || Start Time   || End Time     || Status
8/28/2023 || 1145544    || Arizona              || 8:00:03 AM   || 9:15:17 AM   || For Approval 1
8/28/2023 || 1157788    || Arizona              || 9:15:20 AM   || 12:00:19 PM  || For Approval 1
8/28/2023 ||LUNCH BREAK ||                      || 12:00:18 PM  || 1:00:00 PM   || LUNCH BREAK
8/29/2023 || 1145544    || Arizona              || 1:00:01 PM   || 3:00:00 PM   || For Approval 2
8/29/2023 || 1145544    || Arizona              || 3:30:07 PM   || 3:40:40 PM   || COMPLETED
8/30/2023 || 1157788    || Arizona              || 3:41:00 PM   || 3:50:00 PM   || For Approval 2
9/1/2023  || 1157788    || Arizona              || 4:00:00 PM   || 4:30:45 PM   || COMPLETED
9/2/2023  || 1233343    || New York             || 9:05:17 AM   || 11:30:20 AM  || For Approval 1
9/2/2023  ||LUNCH BREAK ||                      || 12:00:00 AM  || 1:00:00 PM   || LUNCH BREAK
9/2/2023  || 1233343    || New York             || 1:45:01 PM   || 2:45:30 PM   || For Approval 2
9/2/2023  || 1233343    || New York             || 3:00:00 AM   || 3:22:00 AM   || COMPLETED
9/2/2023  || 1422457    || Louisana             || 3:50:00 PM   || 4:12:00 PM   || For Approval 1
9/3/2023  || 1422457    || Louisana             || 10:18:03 AM  || 11:15:17 AM  || For Approval 2
9/4/2023  || 1422457    || Louisana             || 4:15:20 PM   || 4:35:19 PM   || COMPLETED

现在,我获取唯一值/s的代码如下:

Private Sub UserForm_Initialize() 
     
    Dim UniqueList()    As String 
    Dim x               As Long 
    Dim Rng1            As Range 
    Dim c               As Range 
    Dim Unique          As Boolean 
    Dim y               As Long 
     
    Set Rng1 = Sheets("Sheet1").Range("C:C") 
    y = 1 
     
    ReDim UniqueList(1 To Rng1.Rows.Count) 
     
    For Each c In Rng1 
        If Not c.Value = vbNullString Then 
            Unique = True 
            For x = 1 To y 
                If UniqueList(x) = c.Text Then 
                    Unique = False 
                End If 
            Next 
            If Unique Then 
                y = y + 1 
                Me.ListBox1.AddItem (c.Text) 
                UniqueList(y) = c.Text 
            End If 
        End If 
    Next 
     
End Sub

这将返回C列的唯一值。

Project ID
1145544
1157788
LUNCH BREAK
1233343
1422457

在我提供的数据中,请注意还有其他列。在列表框中,我想实现的是(不再吃午饭):

Date         Project ID   Status
8/29/2023    1145544      COMPLETED
9/1/2023     1157788      COMPLETED
9/2/2023     1233343      COMPLETED
9/4/2023     1422457      COMPLETED

提前谢谢。

1 回复 | 直到 3 年前

1

taller 3 年前

Dictionary 对象是获取唯一列表的好选择。

Private Sub UserForm_Initialize()
    Dim Dic As Object, i, sKey, arr, aList()
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        ' load data into array
        arr = .Range(.[g2], .Cells(.Rows.Count, 2).End(xlUp))
        For i = 1 To UBound(arr)
            sKey = Trim(arr(i, 2))
            If Not UCase(sKey) = "LUNCH BREAK" Then
                If Dic.exists(sKey) Then
                    If arr(i, 1) >= Dic(sKey)(0) Then
                        Dic(sKey) = Array(arr(i, 1), Trim(arr(i, 6)))
                    End If
                Else
                    Dic(sKey) = Array(arr(i, 1), Trim(arr(i, 6)))
                End If
            End If
        Next
    End With
    ReDim aList(Dic.Count, 2)
    ' header row
    aList(0, 0) = "Date"
    aList(0, 1) = "Project ID"
    aList(0, 2) = "Status"
    i = 1
    ' transfer data from dict to array
    For Each sKey In Dic.keys
        aList(i, 0) = Dic(sKey)(0)
        aList(i, 1) = sKey
        aList(i, 2) = Dic(sKey)(1)
        i = i + 1
    Next
    ' populate ListBox
    With Me.ListBox1
        .ColumnCount = 3
        .List = aList
    End With
End Sub