Sulprobil
Searchâ€¦
Pfreq
Pfreq lists frequencies of input combinations:
Examples:
Please note that I do not recommend to use the Pfreq(Pfreq(...)) approach for more than some thousand rows: For 10,000 rows and two columns it takes more than 1 minute to calculate on my dual core computer!
If you need a sorted output you can take my UDF GSort.
Function Pfreq(ParamArray v()) As Variant
'Pfreq lists how often each value combination
'in paramarray appears. Example:
' A B
' 2 Myer Ben
' 3 Smith Ben
' 5 Myer Ben
'Now select C1:E3 and array-enter
'=Pfreq(A1:A5,B1:B5) and you will get
' C D E
' 2 Myer Ben 2
' 3 Smith Ben 1
'Reverse("moc.liborplus.www") V0.4 15-Oct-2009
Dim obj As Object
Dim vR As Variant
Dim i As Long, j As Long, k As Long, lvdim As Long
Dim s As String, sC As String
â€‹
With Application.WorksheetFunction
sC = "|"
Set obj = CreateObject("Scripting.Dictionary")
k = 0
v(0) = .Transpose(.Transpose(v(0)))
lvdim = UBound(v(0))
If lvdim > 100 Then lvdim = 100
On Error GoTo ErrHdl
ReDim vR(0 To UBound(v) + 1, 1 To lvdim)
For i = 1 To UBound(v(0))
s = v(0)(i, 1)
For j = 1 To UBound(v)
v(j) = .Transpose(.Transpose(v(j)))
s = s & sC & v(j)(i, 1)
Next j
If obj.Item(s) > 0 Then
vR(UBound(v) + 1, obj.Item(s)) = vR(UBound(v) + 1, obj.Item(s)) + 1
Else
k = k + 1
obj.Item(s) = k
For j = 0 To UBound(v)
vR(j, k) = v(j)(i, 1)
Next j
vR(UBound(v) + 1, k) = 1
End If
Next i
If k > 0 Then ReDim Preserve vR(0 To UBound(v) + 1, 1 To k)
Pfreq = .Transpose(vR)
End With
Exit Function
ErrHdl:
If Err.Number = 9 Then
If i > lvdim Then
'Here we normally get if we breach Ubound(vR,2)
'So we need to increase last dimension
lvdim = 10 * lvdim
If lvdim > UBound(v(0)) Then lvdim = UBound(v(0))
ReDim Preserve vR(0 To UBound(v) + 1, 1 To lvdim)
Err.Number = 0
Resume 'Back to statement which caused error
End If
End If
'Other error - terminate
On Error GoTo 0
Resume
End Function
â€‹
â€‹