Compter en VBA avec critère

[Nashou]

Bonjour à tous,

Je cherche à extraire les données d'une liste selon un critère définit.

Dans mon fichier, onglet BASE, j'ai sur la colonne A une liste de contrats.

Je souhaite (par bouton de commande) passer en revue tous les contrats et si certains sont présent plus d'une fois (strictement supérieur à 1), je les fais apparaitre dans ma feuille RESULTATS.

Dans la feuille RESULTATS :

Colonne A : report du n° de contrat
Colonne B : nombre de fois apparu

Je sais programmer quelques boucles mais là j'ai du mal...

J'espère avoir été assez clair dans ma demande.

Cordialement,

Nashou

 

[R@chid]

Re : Compter en VBA avec critère

Bonjour,
pourquoi le VBA alors qu'on peut le faire avec un TCD...
Amicalement

 

[Nashou]

Re : Compter en VBA avec critère

Bonjour,
pourquoi le VBA alors qu'on peut le faire avec un TCD...
Amicalement

Bonjour Rachid,

Tout à fait d'accord avec toi.
Seulement là, j'ai mis un échantillon du nombre de contrats.
J'ai plus de 50 000 contrats en base qui peuvent revenir plus d'une fois chacun.

Un TCD peut absorber la charge ? N'est-il pas plus simple d'exclure un contrat qui n'est présent qu'une fois et d'afficher ceux avec 2 au minimum. C'est une réflexion, en aucun cas une solution.

 

[WUTED]

Re : Compter en VBA avec critère

Bonjour Nashou, Rachid,

J'ai fait ce que tu voulais faire en vba, les résultats semblent bon, seulement, même en essayant de l'optimiser un maximum, le temps d'exécution est vraiment long, sachant qu'il n'y a que 1000 contrats et quelques dans ton exemple, donc à toi de voir. J'espère que Rachid pourra t'apporter une solution plus sympa avec les TCD.

Sub compteur()
    Dim compteur As Integer
    Dim state As Boolean
    For i = 2 To Sheets("BASE").Range("A65536").End(xlUp).Row
        compteur = 1
        For j = 1 To Sheets("RESULTATS").Range("A65536").End(xlUp).Row
            state = True
            If Sheets("BASE").Range("A" & i).Value = Sheets("RESULTATS").Range("A" & j).Value Then
                state = False
            End If
        Next j
        If state = True Then
            For j = i + 1 To Sheets("BASE").Range("A65536").End(xlUp).Row
                If Sheets("BASE").Range("A" & i).Value = Sheets("BASE").Range("A" & j).Value Then
                    compteur = compteur + 1
                End If
            Next j
            If compteur > 1 Then
                Sheets("RESULTATS").Range("A" & Sheets("RESULTATS").Range("A65536").End(xlUp).Row + 1).Value = Sheets("BASE").Range("A" & i).Value
                Sheets("RESULTATS").Range("B" & Sheets("RESULTATS").Range("B65536").End(xlUp).Row + 1).Value = compteur
            End If
        End If
    Next i
End Sub

EDIT : j'ai mis à jour le code pour corriger un problème de décalage de ligne sur la feuille RESULTATS.

Bonne journée,
WUTED