XL 2019 occurrence de textes dans une colonne

[Sheldor]

bonjour à tous,

je serais le plus heureux de la journée si j'arrivais à avoir le nombre d'occurrences de chaque texte (une cellule = 1 texte) dans la colonne à partir de la cellule sélectionnée.

et je n'en suis pas loin! j'arrive à sortir cette liste mais dans l'ordre de "rencontre" de chaque nouveau texte alors qu'il me faudrait cette liste en ordre alphabétique ... et là hélas je tourne en rond ....

l'exemple en pj permet de comprendre plus facilement

très grand merci par avance

nico

 

[fanch55]

Bonjour,
Grace aux méthodes de BoisGontier :

Option Compare Text
Sub Bouton1_Cliquer()
Dim Plage As Range

Col = ActiveCell.Column
Ligne_Debut = ActiveCell.Row
Ligne_Fin = Cells(Rows.Count, Col).End(xlUp).Row

    'Set Plage = Application.InputBox(Prompt:="Selectionner le Plage de valeur", Type:=8)
    Set Plage = Range(Cells(Ligne_Debut, Col), Cells(Ligne_Fin, Col))
    
    Set Dict = CreateObject("Scripting.Dictionary")
    Dict.CompareMode = vbTextCompare
    For Each Cell In Plage.Cells
        Select Case True
            Case Cell = ""
            Case Dict.exists(Cell.Value): Dict(Cell.Value) = Dict(Cell.Value) + 1
            Case Else:                    Dict(Cell.Value) = 1
        End Select
    Next
    
    DicoTriKeysVal Dict, 1 '1: tri des clés 2: tri des valeurs
    memo_texte = ""
    For Each D In Dict
        memo_texte = memo_texte & D & ":   " & Dict(D) & vbLf
    Next
    MsgBox (memo_texte)
    
End Sub
' http://boisgontierj.free.fr/pages_site/Dictionnaire.htm
Sub Tri(a, gauc, droi, colTri)         ' Quick sort
 ref = a((gauc + droi) \ 2, colTri)
 g = gauc: D = droi
 Do
     Do While a(g, colTri) < ref: g = g + 1: Loop
     Do While ref < a(D, colTri): D = D - 1: Loop
     If g <= D Then
       temp = a(g, 1): a(g, 1) = a(D, 1): a(D, 1) = temp
       temp = a(g, 2): a(g, 2) = a(D, 2): a(D, 2) = temp
       g = g + 1: D = D - 1
     End If
 Loop While g <= D
 If g < droi Then Call Tri(a, g, droi, colTri)
 If gauc < D Then Call Tri(a, gauc, D, colTri)
End Sub
' http://boisgontierj.free.fr/pages_site/Dictionnaire.htm
Sub DicoTriKeysVal(dico, colTri)
  Dim Tbl(): ReDim Tbl(1 To dico.Count, 1 To 2)
  i = 0
  For Each c In dico.keys
    i = i + 1
    Tbl(i, 1) = c: Tbl(i, 2) = dico(c)
  Next c
  Tri Tbl, LBound(Tbl), UBound(Tbl), colTri
  dico.RemoveAll
  For i = LBound(Tbl) To UBound(Tbl)
    dico(Tbl(i, 1)) = Tbl(i, 2)
  Next i
End Sub

 

[Sheldor]

bravo ! très grand merci, j'ai bien essayé de regarder avec les méthodes de Boisgontier mais le niveau est trop loin du mien...
génial, encore merci !

nico

 

[Sheldor]

Bonjour,
je reviens sur cette macro (qui tourne tous les jours sur plusieurs ordis depuis ce 4 juin 2021 ! ) pour savoir s'il est possible de faire cette liste en distinguant les termes aussi en fonction de la casse, problème que je n'avais pas identifié à l'époque...

très grand merci

nico

 

[fanch55]

Bonjour,
Il suffit de remplacer :
Dict.CompareMode = vbTextCompare par Dict.CompareMode = vbBinaryCompare

 

[Sheldor]

ahhhh génial, merci infiniment !