Discussion :

[Denis_67]

Bonjour,

On a fréquemment besoin de calculer le nombre de valeurs uniques d'une série.

Si mes valeurs sont en colonne A la formule en B1 est 1/nb.si(A:A;A1) à recopier sur toute la colonne B par exemple.
(si dans la colonne A j'ai deux fois "bonjour", j'obtiens en face de chaque bonjour 0.5 dont le total fait 1).

Cependant quand le nombre de lignes est élevé, ce calcul est très très long et après chaque modif dans la feuille ça repart.
Habituellement j'effectue un copier coller valeur pour éviter le recalcul après chaque changement, mais si on doit supprimer ou ajouter des valeurs, alors il faut recommencer la manip.

On est passé à plus 1mio de lignes dans Excel, mais on s'aperçoit dans la pratique que dès quelques miliers de lignes on a des fichiers énormes et que les calculs prennent des plombes !

Dans mon exemple d'aujourd'hui jai 53 000 lignes sur 15 colonnes.
Avez-vous une astuce autre que celle cité, ou d'interrompre le recalcul auto et de le lancer à la demande?
Denis

[Michel_M]

Bonjour

faut il chercher sur toutes les colonnes ou sur des colonnes bien précises ?

[Michel_M]

Re
vite fait avant la soupe...
Départ du tableau supposé en A1

0,3 secondes sur 7600 lignes et 15 colonnes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Option Explicit
Sub recenser()
Dim Dercol As Byte, Derlig As Long, T_in
Dim Dico As Object, Lig As Long, Col As Long
Dim start As Single
start = Timer
Application.ScreenUpdating = False
Set Dico = CreateObject("scripting.dictionary")
Dercol = Rows(1).Find(what:="*", searchdirection:=xlPrevious).Column
Derlig = Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
T_in = Range(Cells(1, 1), Cells(Derlig, Dercol))
For Lig = 1 To Derlig
    For Col = 1 To Dercol
        If Not Dico.exists(T_in(Lig, Col)) Then
            Dico.Add T_in(Lig, Col), 1
        Else
            Dico(T_in(Lig, Col)) = Dico(T_in(Lig, Col)) + 1
        End If
    Next
Next
With Sheets(2)
    .Range("A1").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
    .Range("B1").Resize(Dico.Count, 1) = Application.Transpose(Dico.items)
    .Activate
End With
Application.ScreenUpdating = True
MsgBox "durée: " & Timer - start & " sec."
End Sub

[Denis_67]

Bonjour,

Merci pour vos contributions.
Je vois que je n'ai pas été assez précis !

Oui dans le cas cité, je comptabilise une seule colonne.
Par contre je souhaite avoir la valeur relative de chaque occurence pour pouvoir avoir la somme dans un TCD

Je prends donc le code de Michel et je créé une macro perso que je peux utiliser à la demande au fur et à mesure
en l'adaptant pour sélectionner la colonne à compter le calcul du ratio et la colonne cible.
J'ai donc
Valeur A 0.5
Valeur A 0.5
Valeur B 0.33
Valeur B 0.33
Valeur B 0.33 etc....

J'ai 6 secondes pour 50 000 lignes ce qui est correct.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
'Option Explicit
Sub Comptage_unique()
'
' Comptage_unique Macro
' la macro compte le nombre de chaque valeurs d'une colonne
' affiche le ration 1 sur nombre de valeurs pour comptabilisation dans TCD
'
Dim Dercol As Byte, Derlig As Long, T_in
Dim Dico As Object, Lig As Long, Col As Long
Dim start As Single
Dim colcount As Integer
Dim colbut As Integer
Msg = "Indiquer la colonne (en chiffres) à compter"
Title = "Colonne des valeurs à compter"
colcount = Application.InputBox(Msg, Title)
 
Msg = "Indiquer la colonne (en chiffres) où vous voulez le résultat"
Title = "Colonne résultat"
colbut = Application.InputBox(Msg, Title)
 
'start = Timer
Application.ScreenUpdating = False
Set Dico = CreateObject("scripting.dictionary")
Derlig = Columns(colcount).Find(what:="*", SearchDirection:=xlPrevious).Row
T_in = Range(Cells(1, colcount), Cells(Derlig, colcount))
For Lig = 1 To Derlig
        If Not Dico.exists(T_in(Lig, 1)) Then
            Dico.Add T_in(Lig, 1), 1
        Else
            Dico(T_in(Lig, 1)) = Dico(T_in(Lig, 1)) + 1
        End If
Next
For Lig = 1 To Derlig
Cells(Lig, colbut) = 1 / Dico(T_in(Lig, 1))
Next
'Application.ScreenUpdating = True
'MsgBox "durée: " & Timer - start & " sec."
End Sub
'

Merci beaucoup

Denis