Lenteur d'exécution - CountIfs

Bonjour à tous,

Mon code est particulièrement lent, et j'ai repéré la partie problématique :

For x = 2 To Sheets("Synthèse").Range("A1").End(xlDown).Row
Sheets("Synthèse").Range("D" & x) = Application.CountIfs(Sheets("Données").Columns("H"), Sheets("Synthèse").Range("A" & x), Sheets("Données").Columns("M"), Sheets("Synthèse").Range("B" & x), Sheets("Données").Columns("P"), Sheets("Synthèse").Range("C" & x), Sheets("Données").Columns("S"), "XXX")
Next x

L'onglet "Synthèse" cherche le nombre d'occurrences en onglet "Données" des trois premières colonnes, avec :

- Colonne A de "Synthèse" renvoie à la colonne H de "Données"

- Colonne B de "Synthèse" à la colonne M de "Données"

- Colonne C de "Synthèse" à la colonne P de "Données"

- Uniquement si la colonne S de "Données" est "XXX"

Savez-vous comment je pourrais améliorer le temps d'exécution de ce code ?

Je vous remercie et vous souhaite une belle journée !

Bonjour

Savez-vous comment je pourrais améliorer le temps d'exécution de ce code ?

Peut-être en passant par des variables tableaux ?

Pour faire un essai, encore faudrait-il disposer de ton fichier...

Bye !

Bonjour,

C'est vrai, avec une pièce-jointe : c'est mieux !

Merci beaucoup pour cette option. Si je comprends bien, je crée un tableau avec les trois premières colonnes de "Synthèse" ?

Est-il possible de le réaliser depuis l'onglet "Source" - puisque les données recherchées en onglet "Synthèse" sont celles sans-doublon ?

Un essai à tester. Te convient-il ?

Option Explicit

Dim tablo, tabloC(), tabloR(), dico As Object, k
Dim i&

Sub Resultat()

    tablo = Sheets("Données").Range("A2:S" & Sheets("Données").Range("A" & Rows.Count).End(xlUp).Row)
    Set dico = CreateObject("Scripting.Dictionary")

    For i = 2 To UBound(tablo, 1)
        If tablo(i, 19) <> "XXX" Then
            If dico.exists(tablo(i, 8) & " " & tablo(i, 13) & " " & tablo(i, 16)) Then
                dico(tablo(i, 8) & " " & tablo(i, 13) & " " & tablo(i, 16)) _
                        = dico(tablo(i, 8) & " " & tablo(i, 13) & " " & tablo(i, 16)) + 1
            Else
                dico(tablo(i, 8) & " " & tablo(i, 13) & " " & tablo(i, 16)) = 1
            End If
        End If
    Next i
    k = dico.keys

    ReDim tabloR(1 To dico.Count, 1 To 4)
    For i = 0 To dico.Count - 1
        tabloR(i + 1, 1) = Split(k(i), " ")(0)
        tabloR(i + 1, 2) = Split(k(i), " ")(1)
        tabloR(i + 1, 3) = Split(k(i), " ")(2)
        tabloR(i + 1, 4) = dico(k(i))
    Next i
    Sheets("Synthèse").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Sheets("Synthèse").Range("A2").Resize(dico.Count, 4) = tabloR
End Sub

Bye !

Merci beaucoup !

Je ne suis pas du tout familière avec l'objet Dictionnaire, je vais étudier ça de plus près.

A première vue, il semblerait que la dernière ligne de l'onglet "Source" ne soit pas prise en compte. Et s'il y a des espaces en colonne 16 - seul le premier mot est retranscrit.

Je me penche sur ton code ! Encore merci

il semblerait que la dernière ligne de l'onglet "Source" ne soit pas prise en compte

Je ne vois pas ce qui te fait dire ça. :

Et s'il y a des espaces en colonne 16 - seul le premier mot est retranscrit.

Exact.

Remplace la macro par celle-ci :

Option Explicit

Dim tablo, tabloC(), tabloR(), dico As Object, k
Dim i&

Sub Resultat()

    tablo = Sheets("Données").Range("A2:S" & Sheets("Données").Range("A" & Rows.Count).End(xlUp).Row)
    Set dico = CreateObject("Scripting.Dictionary")

    For i = 2 To UBound(tablo, 1)
        If tablo(i, 19) <> "XXX" Then
            If dico.exists(tablo(i, 8) & "#" & tablo(i, 13) & "#" & tablo(i, 16)) Then
                dico(tablo(i, 8) & "#" & tablo(i, 13) & "#" & tablo(i, 16)) _
                        = dico(tablo(i, 8) & "#" & tablo(i, 13) & "#" & tablo(i, 16)) + 1
            Else
                dico(tablo(i, 8) & "#" & tablo(i, 13) & "#" & tablo(i, 16)) = 1
            End If
        End If
    Next i
    k = dico.keys

    ReDim tabloR(1 To dico.Count, 1 To 4)
    For i = 0 To dico.Count - 1
        tabloR(i + 1, 1) = Split(k(i), "#")(0)
        tabloR(i + 1, 2) = Split(k(i), "#")(1)
        tabloR(i + 1, 3) = Split(k(i), "#")(2)
        tabloR(i + 1, 4) = dico(k(i))
    Next i
    Sheets("Synthèse").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Sheets("Synthèse").Range("A2").Resize(dico.Count, 4) = tabloR
End Sub

Bye !

Merci ! En bidouillant de mon côté, j'avais fini par comprendre qu'il suffisait de remplacer les espaces par un caractère spécial

Pour la première partie, j'ai essayé d'ajouter une colonne qui compte l'ensemble des occurrences et non seulement celles contenant "XXX" - et je me suis rendue compte qu'on ne retrouvait pas le même nombre de lignes de "Source" :

Bizarre !

Il y a en effet une anomalie que je ne m'explique pas. Je note toutefois qu'on a la même chose si on utilise ta macro initiale en cliquant sur le bouton "Cliquer ici".

Si tu trouves d'où ça vient, ça m'intéresse.

Bye !

Bonjour à tous,

et pourquoi pas un simple TCD ?
Clic-droit dessus et Actualiser, c'est presque instantané

eric