Question

我有一个表示我的userform的命令按钮的子，这个userform具有列出（在列表框中）在二维数组的列中找到的所有唯一项的perpose。首先，我想植入一个额外的变量来保持，从而表示唯一项目在数组中出现的次数。其次，我希望列出的（唯一）项目为：

唯一项目1 （出现次数）。

示例1（23）

示例2（39）

实施例3（101）

实施例4（9）

...

示例n（＃）

这是代码，有人可以帮我解决一下吗？

NavController

End Sub

Answer 1

使用字典存储计数？这证明了这一原则。请注意，在您的示例中，我认为您可能只会添加一列G，因此我不知道您的意图更多？

Sub test()

Dim myArray()

myArray = ActiveSheet.Range("A1").CurrentRegion.Value

Dim dict As Object

Set dict = CreateObject("Scripting.Dictionary")

Dim i As Long

For i = LBound(myArray, 1) To UBound(myArray, 1) 'Depending on column of interest. Loop that

    If Not dict.Exists(myArray(i, 1)) Then
        dict.Add myArray(i, 1), 1
    Else
       dict(myArray(i, 1)) = dict(myArray(i, 1)) + 1
    End If

Next i

Dim key As Variant

For Each key In dict.keys
    Debug.Print key & "(" & dict(key) & ")"
Next key

End Sub

你的例子可能是这样的（不能在Mac上测试词典，我害怕这样编码）

Sub test()

    Dim aData()
    Dim ws As Worksheet
    Dim targetRange As Range
    Dim lastRow As Long

    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row

   If lastRow = 1 Then Exit Sub

    Set targetRange = ws.Range("G2:G" & lastRow)

    If targetRange.Cells.Count = 1 Then
        ReDim aData(1 To 1, 1 To 1)
        aData(1, 1) = targetRange.Value
   Else
       aData = targetRange.Value2
   End If

    Dim dictUnq As Object

    Set dictUnq = CreateObject("Scripting.Dictionary")

    Dim i As Long

    For i = LBound(aData, 1) To UBound(aData, 1) 'Depending on column of interest. Loop that

        If Not dictUnq.Exists(aData(i, 1)) Then
            dictUnq.Add aData(i, 1), 1
        Else
           dictUnq(aData(i, 1)) = dictUnq(aData(i, 1)) + 1
        End If

    Next i

    Dim key As Variant

    For Each key In dictUnq.keys
        Debug.Print key & "(" & dictUnq(key) & ")"
    Next key

End Sub

Answer 2

另一种可能性

Option Explicit

Private Sub CommandButton5_Click()
    Dim dictUnq As Object
    Set dictUnq = CreateObject("Scripting.Dictionary")

    Dim cell As Range
    With ActiveWorkbook.Sheets("Sheet3")
        For Each cell In .Range("G2", .Cells(.Rows.Count, "G").End(xlUp))
            dictUnq(cell.Value) = dictUnq(cell.Value) + 1
        Next
    End With

    If dictUnq.Count = 0 Then Exit Sub

    Dim key As Variant
    With SBI_Omschrijving.ListBox1
        .Clear
        .ColumnCount = 2
        For Each key In dictUnq.keys
            .AddItem key
            .List(.ListCount - 1, 1) = dictUnq(key)
        Next
    End With

    MsgBox "Unique findings:  " & dictUnq.Count
End Sub

植入一个额外的变量来计算在数组中找到“唯一”项的次数。

2 个答案: