Tri horizontal "amélioré" pour Excel 2010
Bonjour,
J'ai un grand nombre de chiffres sur une ligne (un chiffre par cellule).
J'ai environ 500 cellules contenant un chiffre par ligne.
Je voudrais classer les chiffres en fonction du nombre de fois qu'ils sont cités.
Exemple : j'ai 15 en a1, d1, f1; 18 en c1, e1; 16 en c1; 19 en g1,h1,i1 et j1
Je voudrais avoir un tri qui m'affiche les plus cités en premier.
Par exemple quelque chose comme ça :
19(4) 15(3) 18(2) 16(1) <<< Classement des chiffres en fonction du nombre de fois où ils sont cités (le nombre de fois où le chiffre est cité)
J'espère que j'ai été clair
J'utilise Excel 2010
Merci d'avance
Bonjour,
En fichier joint une solution avec les explications dans le fichier Excel
En espérant t'avoir aider !
Bonjour,
une autre solution avec une fonction personnalisée
Function lpc(r As Range)
Dim k, v
Set dico = CreateObject("Scripting.Dictionary")
For Each c In r
d = Application.WorksheetFunction.CountIf(r, c)
If Not dico.exists(c.Value) Then
dico.Add c.Value, d
End If
Next
v = dico.items
k = dico.keys
For i = LBound(v) To UBound(v) - 1
For j = i + 1 To UBound(v)
If v(i) < v(j) Then a = v(i): v(i) = v(j): v(j) = a: a = k(i): k(i) = k(j): k(j) = a
Next j
Next i
s = ""
For i = LBound(v) To UBound(v)
If s <> "" Then s = s & ","
s = s & k(i) & "(" & v(i) & ")"
Next i
lpc = s
End Functionça semble bien marcher !
Je vous confirme cela ce soir.
En tout cas, merci de m'avoir aidé aussi rapidement
Est-ce qu'il est possible d'avoir les chiffres les plus cités inscrit à la suite dans des cellules comme dans le fichier joint ?
bonjour,
une solution via une macro
sélectionner les cellules à prendre en compte puis lancer la macro lpc via alt-f8, résultat sur la ligne sous de la sélection.
Sub lpc()
Dim k, v
Set dico = CreateObject("Scripting.Dictionary")
For Each c In Selection
d = Application.WorksheetFunction.CountIf(Selection, c)
If Not dico.exists(c.Value) Then
dico.Add c.Value, d
End If
Next
v = dico.items
k = dico.keys
For i = LBound(v) To UBound(v) - 1
For j = i + 1 To UBound(v)
If v(i) < v(j) Then a = v(i): v(i) = v(j): v(j) = a: a = k(i): k(i) = k(j): k(j) = a
Next j
Next i
li = Selection.Row + 1
Rows(li).ClearContents
co = 0
For i = LBound(v) To UBound(v)
co = co + 1
Cells(li, co) = k(i)
Next i
End SubBonjour,
Merci de t'occuper de mes problèmes
Je vais encore abuser en te demandant si on peut faire toutes les lignes d'un coup et si le résultat pouvait s'afficher à côté des zones sélectionnées.
J'ai 365 lignes qui se suivent sans "ligne vierge"
bonjour,
une proposition d'adaptation
Sub lpc()
Dim ke, v
premièrecolonne = "A"
dernièrecolonne = "M" 'à modifier
dernièreligne = Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To dernièreligne
Range(premièrecolonne & k & ":" & dernièrecolonne & k).Select
co = Selection.Columns.Count + 1
Set dico = CreateObject("Scripting.Dictionary")
For Each c In Selection
If Not dico.exists(c.Value) Then
d = Application.WorksheetFunction.CountIf(Selection, c)
dico.Add c.Value, d
End If
Next
v = dico.items
ke = dico.keys
For i = LBound(v) To UBound(v) - 1
For j = i + 1 To UBound(v)
If v(i) < v(j) Then a = v(i): v(i) = v(j): v(j) = a: a = ke(i): ke(i) = ke(j): ke(j) = a
Next j
Next i
li = Selection.Row
For i = LBound(v) To UBound(v)
co = co + 1
Cells(li, co) = ke(i)
Next i
Erase v
Erase ke
Set dico = Nothing
Next k
End SubÇa marche bien.
Par contre comment sont gérées les égalités?
Si 15 et 16 apparaissent 10 fois chacun. Lequel des deux sera affiché en premier? Le plus petit?
Est-ce que l'on peut les départager de sorte que celui qui apparaît le plus en premier soit en tête?
Merci pour tout !
je deduis de ton message que je n'ai pas compris ce que tu voulais.
je t'ai adapté la macro pour qu'elle te donne par ligne les nombres dans l'ordre de leur fréquence d'apparition
dois-je comprendre que tu souhaites les nombres dans l'ordre de leur fréquence d'apparition pour les 365 lignes ?
Non c'est très bien ce que tu as fait ! j'ai bien les nombres dans l'ordre de leur fréquence d'apparition
Par contre, sur une ligne il peut y avoir le cas où 2 nombres sont cités le même nombre de fois.
A chaque fois, j'ai une série de 8 chiffres différents puis de nouveau une série de 8 chiffres
Est-ce qu'il serait possible d'avoir le tri des ex-æquo en fonction de leur placement?
Exemple :
J'ai 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8 1 8 2 3 4 5 6 7
J'aimerais qu'en cas d'égalité d’occurrence celui qui apparaît en premier soit celui qui est cité le plus souvent en 1er, puis en 2ème, puis en 3ème...
Cela donnerait à la fin 1 2 3 4 5 8 6 7 (Le 8 est devant le 6 et 7 car il a été placé à la 2ème place dans la 3ème séquence)
Mais si cela n'est pas possible, je reste avec ce que tu as fait et qui est déjà une aide formidable.
re-bonjour
un autre essai, basé sur la dernière position trouvée
Sub lpc()
Dim ke, v
premièrecolonne = "A"
dernièrecolonne = Cells(1, Columns.Count).End(xlToLeft).Column
dernièreligne = Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To dernièreligne
Range(Cells(k, premièrecolonne), Cells(k, dernièrecolonne)).Select
co = Selection.Columns.Count + 1
Set dico = CreateObject("Scripting.Dictionary")
For Each c In Selection
d = Application.WorksheetFunction.CountIf(Selection, c) * 100000
If Not dico.exists(c.Value) Then
dico.Add c.Value, d + (dernièrecolonne - c.Column)
Else
n = d + dernièrecolonne - c.Column
dico(c.Value) = n
End If
Next
v = dico.items
ke = dico.keys
For i = LBound(v) To UBound(v) - 1
For j = i + 1 To UBound(v)
If v(i) < v(j) Then a = v(i): v(i) = v(j): v(j) = a: a = ke(i): ke(i) = ke(j): ke(j) = a
Next j
Next i
li = Selection.Row
For i = LBound(v) To UBound(v)
co = co + 1
Cells(li, co) = ke(i)
Next i
Erase v
Erase ke
Set dico = Nothing
Next k
End Sub