"Dé grootste en gratis computerhelpdesk van Nederland"
Privacywetgeving
Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.
Sub hsv()
Dim sn, i As Long, ii As Long
sn = ActiveSheet.ListObjects(1).DataBodyRange
For i = 1 To 3
With CreateObject("scripting.dictionary")
For ii = 1 To UBound(sn)
If Len(sn(ii, 1)) = 3 + i * 3 Then .Item(sn(ii, 1)) = .Item(sn(ii, 1)) + 1
Next ii
If .Count > 0 Then
Cells(Rows.Count, 4 + i * 3 - 2).End(xlUp).Offset(1).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
End If
.RemoveAll
End With
Next i
End SubSub hsv()
Dim sn, i As Long, ii As Long, Lobj As ListObject
sn = ActiveSheet.ListObjects(1).DataBodyRange
For i = 1 To 3
With CreateObject("scripting.dictionary")
For ii = 1 To UBound(sn)
If Len(sn(ii, 1)) = 3 + i * 3 Then .Item(sn(ii, 1)) = .Item(sn(ii, 1)) + 1
Next ii
If .Count > 0 Then
Set Lobj = ActiveSheet.ListObjects(i + 1)
Lobj.DataBodyRange.Cells(Lobj.DataBodyRange.Rows.Count, 1).End(xlUp).Offset(1).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
End If
.RemoveAll
End With
Next i
End Sub
