我更喜欢用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 A索引的COL B中唯一结果的计数
COL A COL B
A 2
B 1
我从这个开始,然后我的头开始旋转(我真的很讨厌VBA,它不为我点击):
编辑-删除垃圾我开始,因为它是没有帮助任何人。这就是我最终使用的,我必须修改@alter answer以只显示大于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
快速解决方案,只需使用2D字典。第一个维度是列A(要索引的列),第二个维度是列B(值)。字典的好处是它们有一个"Exists"函数,它会检查一个键是否已经在使用
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
另一种方法:
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
您可能应该考虑使用数据透视表。这将返回您正在寻找的最终结果。只需选择整个区域,创建一个数据透视表,并将两列放入"行标签"区域。
这消除了对大量令人费解的VBA脚本的需要。