Question

我更喜欢用VBA执行此操作，根据需要执行而不是公式，因为我有16000行。

电子表格在COL A中列出了几百个条目。我需要查看其中有多少在COL B中有不同的值

COL A   COL B
A       1
A       2
A       1
A       1
A       2
A       1
A       1
A       1
B       1
B       1
B       1
B       1
B       1

现在返回COL B中唯一结果的计数，由COL A

索引

COL A   COL B
A       2
B       1

我从这开始，然后我的头开始旋转（我真的很讨厌VBA它根本没有点击我）：

编辑 - 删除了我开始使用的垃圾，因为它对任何人都没有帮助。这就是我最终使用的必须修改@alter的答案只显示大于1的索引，然后将其输出到文本文件而不是msgbox（我第一次运行它时有数百个msgbox。

Sub CountUnique()
    On Error GoTo ErrorHandler:
    Dim keyMap As Object, values As Object
    Dim key As String, value As String
    Dim keysColumn As String, valuesColumn As String
    Dim row As Long
    Dim rowCount As Long
    Dim item As Object
    Dim outFile As String

    myFile = "C:\usercount.txt"
    Set keyMap = CreateObject("Scripting.Dictionary")
    rowCount = ActiveSheet.UsedRange.Rows.Count
    keysColumn = "C"
    valuesColumn = "E"

    For row = 2 To rowCount
        key = Range(keysColumn & row).Text
        value = Range(valuesColumn & row).Text
        If keyMap.Exists(key) Then
            Set values = keyMap.item(key)
            If values.Exists(value) = False Then values.Add value, ""
        Else
            Set values = CreateObject("Scripting.Dictionary")
            values.Add value, ""
            keyMap.Add key, values
        End If
    Next row

    Open myFile For Output As #1
    For Each v In keyMap.keys
        key = v
        Set values = keyMap.item(key)
            If values.Count > 1 Then
               Write #1, key & ": " & values.Count
            End If
    Next v
    Close #1
    Exit Sub
ErrorHandler:
    MsgBox "Something went wrong"
End Sub

Answer 1

快速解决方案，只需使用2D字典。第一个维度是列A（您要索引的列），第二个维度是列B（值）。关于词典的好处是他们有一个＆＃34; Exists＆＃34;用于检查密钥是否已被使用的功能

Sub CountUnique()
    On Error GoTo ErrorHandler:
    Dim keyMap As Object, values As Object
    Dim key As String, value As String
    Dim keysColumn As String, valuesColumn As String
    Dim row As Long
    Dim rowCount As Long
    Dim item As Object

    Set keyMap = CreateObject("Scripting.Dictionary")
    rowCount = ActiveSheet.UsedRange.Rows.Count
    keysColumn = "A"
    valuesColumn = "B"

    For row = 2 To rowCount
        key = Range(keysColumn & row).Text
        value = Range(valuesColumn & row).Text
        If keyMap.Exists(key) Then
            Set values = keyMap.item(key)
            If values.Exists(value) = False Then values.Add value, ""
        Else
            Set values = CreateObject("Scripting.Dictionary")
            values.Add value, ""
            keyMap.Add key, values
        End If
    Next row

    For Each v In keyMap.keys
        key = v
        Set values = keyMap.item(key)
        MsgBox key & ": " & values.Count
    Next v

    Exit Sub
ErrorHandler:
    MsgBox "Something went wrong"
End Sub

Answer 2

另一种方法：

Sub Tester()
    CountUnique Range("A2:A10"), Range("d2")
End Sub


Sub CountUnique(rngIn As Range, rngOut As Range)

    Dim d As Object
    Dim c As Range, tmp, v, arr(), i As Long, ex, k

    Set d = CreateObject("scripting.dictionary")

    For Each c In rngIn.Cells

        tmp = Trim(c.Value)
        v = Trim(c.Offset(0, 1).Value)

        If d.exists(tmp) Then
            arr = d(tmp)
            ex = False
            For i = LBound(arr) To UBound(arr)
                If v = arr(i) Then
                    ex = True
                    Exit For
                End If
            Next i
            If Not ex Then
                ReDim Preserve arr(LBound(arr) To UBound(arr) + 1)
                arr(UBound(arr)) = v
                d(tmp) = arr
            End If
        Else
            ReDim arr(0 To 0)
            arr(0) = v
            d(tmp) = arr
        End If
    Next c

    i = 0
    For Each k In d.keys
        rngOut.Offset(i, 0).Value = k
        arr = d(k)
        rngOut.Offset(i, 1).Value = Join(arr, ",")
        rngOut.Offset(i, 2).Value = 1 + (UBound(arr) - LBound(arr))
        i = i + 1
    Next k
End Sub

Answer 3

您应该考虑使用数据透视表。这将返回您正在寻找的最终结果。只需选择整个范围，创建一个数据透视表，并将两列放入＆＃34;行标签＆＃34;区域。

这消除了大量令人费解的VBA脚本的需要。

返回COL B中唯一结果的计数，由COL A索引

3 个答案: