Calcul extremement long

[alcalzone]

Bonsoir à tous,

Je sollicite une fois de plus votre aide.
J'utilise la formule =SOMMEPROD((1/NB.SI(Série;Série)))
qui permet de compter le nombre de N° de série différents dans une colonne.
Tout se passe bien quand j'ai une centaine de ligne.
Par contre, cas général, j'ai environ 30000 lignes.
Dans ce cas, le temps de calcul passe à 15 minutes.
Le problème c'est que j'utilise cette formule 17 fois dans la même feuille.
Le temps de calcul dépasse alors 1 heure.

N'y aurait-il pas une formule plus rapide??

Merci d'avance de votre aide

 

[soenda]

Re : Calcul extremement long

Re,
Bonsoir Job

Sur le principe de la macro, un autre exemple ...

Sub b()
    Dim C As Range
    Dim r As Double
 
    r = 1
    For Each C In Range("A2", [A65536].End(xlUp))
       If C.Offset(1).Value > C.Value Then r = r + 1
    Next
 
    MsgBox r
End Sub

Sur 30 000 données on voit la différence ... A ma grande surprise 😱

Bien sûr on peut mettre tout ça sous forme de fonction

A plus

 

[alcalzone]

Re : Calcul extremement long

Bonsoir job75,

Je n'ai qu'un mot à dire: SUPER
Un grand merci à toi. Quelle rapidité de calcul!!
Je t'avouerai que je ne comprends pas ta macro.
Peux-tu me l'expliquer que je me couche moins bête?

Merci d'avance pour cette aide précieuse

 

[job75]

Re : Calcul extremement long

Re,

@ soenda : ta macro suppose le tableau trié et doit être très rapide. Plus que la méthode "Scripting.Dictionary" (sur tableau non trié) peut-être mais je n'en suis pas sûr. Ce serait intéressant de comparer.

@ alcalzone : tout repose sur l'utilisation de cette méthode, qui permet de créer une collection d'items sans doublons. Pour avoir plus d'information là-dessus, voir le site de Jacques Boisgontier.

A+

 

[job75]

Re : Calcul extremement long

Re,

J'ai testé (ordi 2 Ghz) sur un tableau de 30000 lignes :

- macro de soenda (tableau trié) : 0,47 s

- "Scripting.Dictionary" (tableau non trié ou trié) : 0,87 s

A+

 

[soenda]

Re : Calcul extremement long

Re,

@Job75
Les données sont triées, d'après l'énoncé du problème, cependant ...

Et pour le reste, j'ai fait les tests avec un max de données différentes.

Et je n'ai pas obtenu le même résultat que toi (c'était la surprise du jour, pour moi). Voir PJ

A plus

 

[job75]

Re : Calcul extremement long

Bonjour soenda, le fil, le forum,

"Scripting.Dictionary" prend du temps pour stocker des valeurs numériques.

Il faut les transformer en texte d'abord :

v = CStr(cel)
If Not d.Exists(v) Then d.Add v, v

C'est encore mieux, je trouve 0,40 s et 0,47 s. Merci d'avoir insisté.

Cijoint.fr - Service gratuit de dépôt de fichiers

A+

 

[alcalzone]

Re : Calcul extremement long

Bonjour Jocelyn, soenda, job75,

La solution de job75 me convient parfaitement même si le calcul est un poil plus long. Je plaisante, je ne suis pas à la demi seconde prete
Est-il possible d'adapter cete macro avec un critère.
Je m'explique. Les N° de série sont affectés à un secteur (renseigné dans une autre colonne)
Est il possible maintenant de compter le nombre de N° de série différent en fonction d'un secteur
Je vous remets mon exemple avec l'ancienne formule pour être plus clair.

Merci

 

[job75]

Re : Calcul extremement long

Bonjour alcalzone,

Si les secteurs sont en nombre limité comme ici, et connus à l'avance, c'est assez simple :

Sub Compte()
Dim d As Object, cel As Range, v$, n1 As Long, n2 As Long, n3 As Long
Set d = CreateObject("Scripting.Dictionary")
For Each cel In [série]
v = CStr(cel)
If Not d.Exists(v) Then
d.Add v, v
Select Case cel.Offset(, 1)
Case "s01": n1 = n1 + 1
Case "s02": n2 = n2 + 1
Case "s03": n3 = n3 + 1
End Select
End If
Next
[G5] = n1
[G6] = n2
[G7] = n3
[G8] = d.Count
End Sub

Avec des secteurs inconnus, je vais essayer de voir, mais l'expert dans ces choses là c'est Jacques Boisgontier.

A+

 

[alcalzone]

Re : Calcul extremement long

Bonjour Job75 et encore merci de prendre du temps sur mes problèmes.
J'étais justement entrain de parcourir le site de Jacques Boisgontier qui est fort intérressant.
Je vais essayer d'adapter ta macro à mon fichier qui comporte 6 secteurs puis 16 personnes par secteurs.

Je ne perds pas espoir d'y arriver
J

 

[job75]

Re : Calcul extremement long

Re,

A priori il y a 6 x 16 = 96 personnes différentes.

Pour compter les n° de série pour chaque personne, il y aurait 96 Case différents, et il faudrait écrire tous les noms dans la macro.

C'est laborieux, il doit y avoir mieux en travaillant sur les Keys et les Items de 2 collections d1 (pour les secteurs) et d2 (pour les personnes).

A+

 

[job75]

Re : Calcul extremement long

Re,

Voici donc une solution sans connaître les secteurs à l'avance.

En fait j'ai utilisé un nouvel objet "Scripting.Dictionary" => d1 et un tableau auxiliaire => tablo1.

Si l'on ajoute un nouveau critère, les personnes par exemples, créer d2 et tablo2. Pas trop difficile à adapter.

Edit : je mets quand même la macro :

Option Base 1

Sub Compte()
Dim d As Object, d1 As Object, cel As Range, v$, v1$
Dim tablo1(), plage1 As Range, i As Long, n As Long
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")

For Each cel In [série]
  v = CStr(cel)
  If Not d.Exists(v) Then
    d.Add v, v
    v1 = CStr(cel.Offset(, 1))
    ReDim Preserve tablo1(d.Count)
    tablo1(d.Count) = v1
    If Not d1.Exists(v1) Then d1.Add v1, v1
  End If
Next

Range("F5:G65536").ClearContents
Set plage1 = Range("F5:F" & d1.Count + 4)
plage1 = Application.Transpose(d1.items)
plage1.Sort Key1:=plage1, Order1:=xlAscending, Header:=xlNo
For Each cel In plage1
  n = 0
  For i = 1 To UBound(tablo1)
    If tablo1(i) = cel Then n = n + 1
  Next
  cel.Offset(, 1) = n
Next
plage1.End(xlDown).Offset(1) = "Total"
plage1.End(xlDown).Offset(, 1) = d.Count
End Sub

A+

 

[job75]

Re : Calcul extremement long

Re,

Je n'avais pas fait attention à une chose : un même n° de série peut se retrouver sur des secteurs différents.

En toute logique, il faut alors considérer qu'il y a doublons seulement quand n° de série et secteur sont identiques.

La macro modifiée :

Option Base 1

Sub Compte()
Dim d As Object, d1 As Object, cel As Range, v$, v1$
Dim tablo1(), plage1 As Range, i As Long, n As Long
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")

For Each cel In [série]
  [COLOR="Red"]v1 = CStr(cel.Offset(, 1))
  v = cel & Chr(1) & v1[/COLOR]
  If Not d.Exists(v) Then
    d.Add v, v
    ReDim Preserve tablo1(d.Count)
    tablo1(d.Count) = v1
    If Not d1.Exists(v1) Then d1.Add v1, v1
  End If
Next

Range("F5:G65536").ClearContents
Set plage1 = Range("F5:F" & d1.Count + 4)
plage1 = Application.Transpose(d1.items)
plage1.Sort Key1:=plage1, Order1:=xlAscending, Header:=xlNo
For Each cel In plage1
  n = 0
  For i = 1 To UBound(tablo1)
    If tablo1(i) = cel Then n = n + 1
  Next
  cel.Offset(, 1) = n
Next
plage1.End(xlDown).Offset(1) = "Total"
plage1.End(xlDown).Offset(, 1) = d.Count
End Sub

A+

 

[soenda]

Re : Calcul extremement long

Bonjour le fil, Job75

"Scripting.Dictionary" prend du temps pour stocker des valeurs numériques.
Il faut les transformer en texte d'abord ...

Merci pour l'astuce 🙂

A plus

 

[alcalzone]

Re : Calcul extremement long

Bonsoir job75, soenda,

J'essaye désespérément d'adapter la macro de job75 mais sans succès.
Je m'y prends sans doute comme un manche.
je vous mets l'exemple modifié en fonction de mon fichier.
Un total se calcule mais c'est tout.
A l'aide, je n'y comprends plus rien

 

[alcalzone]

Re : Calcul extremement long

Bonsoir job75, soenda,

J'essaye désespérément d'adapter la macro de job75 mais sans succès.
Je m'y prends sans doute comme un manche.
je vous mets l'exemple modifié en fonction de mon fichier.
Un total se calcule mais c'est tout.
A l'aide, je n'y comprends plus rien

Avec la pièce jointe