Je me suis donc intrigué par cette question et je voulais trouver un moyen de la résoudre avec une macro. Je sais que vous avez dit que vous voudriez éviter une macro, mais je ne crois pas que cela puisse être fait avec une fonction seule.
Le code ci-dessous passe en boucle sur la cellule B2: B25 (cela peut être modifié ou modifié en un paramètre ou les cellules sélectionnées, mais cela semblait plus facile pour le moment). Il utilise une classe personnalisée nommée KeyValue pour agréger le nom de la balise et le nombre d'occurrences. Cela pourrait être amélioré avec l'utilisation d'un objet Dictionnaire, mais cela nécessite d'autres compléments. Il sépare les étiquettes délimitées par des virgules de chaque cellule et compte la fréquence. Ensuite, il affiche cette liste dans les deux premières colonnes de la deuxième feuille de calcul.
Pour ajouter le code, vous devez procéder comme suit. Tout d’abord sur le classeur, vous devez activer la barre d’outils Développeur puis, à partir de là, cliquez sur le Visual Basic
bouton. Ajoutez ensuite un nouveau module de classe et nommez-le KeyValue
. Collez dans le code suivant:
Public Key As String
Public Value As Integer
Public Sub Init(k As String, v As Integer)
Key = k
Value = v
End Sub
Ensuite, sur la feuille Sheet1, ajoutez le code suivant:
Public Sub CountTags()
Dim kv As KeyValue
Dim count As Integer
Dim tag As String
Dim tags As New Collection
Dim splitTags As Variant
For Each Cell In Sheet1.Range("B2:B25")
' Split the comma separated list and process each tag
splitTags = Split(Cell.Value, ", ")
For tagIndex = LBound(splitTags) To UBound(splitTags)
tag = splitTags(tagIndex)
' If tag is in collection get new count otherwise start at 1.
If Contains(tags, tag) Then
Set kv = tags(tag)
count = kv.Value + 1
tags.Remove tag
Else
count = 1
End If
' Add tag to the collection with its count.
Set kv = New KeyValue
kv.Init tag, count
tags.Add kv, tag
Next
Next Cell
Dim rowIndex As Integer
rowIndex = 1
For Each pair In tags
Set kv = pair
Sheet2.Cells(rowIndex, 1) = kv.Key
Sheet2.Cells(rowIndex, 2) = kv.Value
rowIndex = rowIndex + 1
Next pair
End Sub
Private Function Contains(col As Collection, Key As Variant) As Boolean
Dim obj As Variant
On Error GoTo err
Contains = True
Set obj = col(Key)
Exit Function
err:
Contains = False
End Function
Cliquez sur le bouton Exécuter pour qu'il compte les tags.