调整此VBA代码以计算列中的重复项

Question

我无法根据自己的情况调整此代码。我想创建一个函数，允许我计算列中重复项的数量（我相信它目前只计算行数）。 非常感谢！

Function CountPairs(rng As Variant) As Integer
Dim v As Variant
Dim count, length, i As Integer
Dim found As Boolean
count = 0
found = False
v = rng
length = UBound(v, 2)

 For i = 1 To length

' Count if second of pair

 If Not (IsEmpty(v(1, i))) Then
 If found Then
     count = count + 1
     found = False
 Else
     found = True
 End If
Else
 found = False
End If

Next i

CountPairs = count

End Function

Answer 1

为什么不将您希望将重复项计算的范围复制到新工作表中，转置它然后应用RemoveDuplicates函数 - 您的重复项数将为Selection.Rows.Count - (WorksheetFunction.CountA (Selection)/Selection.Columns.Count))

Answer 2

以下数组公式将计算重复项：

=SUM(IF(COUNTIF(A1:A13,A1:A13)=2,1/COUNTIF(A1:A13,A1:A13)))

作为数组公式，必须在退出编辑模式时使用Ctrl-Shift-Enter而不是Enter确认。如果操作正确，那么Excel会将{}放在公式周围。

如果你想将任意倍数，三次重复等计为1，那么：

=SUM(IF(COUNTIF(A1:A13,A1:A13)>1,1/COUNTIF(A1:A13,A1:A13)))

如果您只想计算唯一的非空单元格，那么：

=SUM(IF(A1:A13<>"",1/COUNTIF(A1:A13,A1:A13)))