Macro sur 145 000 lignes

Allez je vais essayer !

Je vais essayer de d'appliquer la version 4 de Steelson avec la nouvelle formule de VDMICHEL.

Bonjour Steelson,

la formule exacte est :

SI($G1="000000";0;SI(NB.SI($X$1:X2;$X2)>1;0;1))

pour la colone AK2 jusqu'à la dernière ligne non vide.

Merci beaucoup.

tu es sûr de ton $G1 ? ce n'est pas $G2 ?

Un essai...

Sub version_v3()

Dim critere As Variant, critere2 As Variant, resultat As Variant, resultat2 As Variant, i As Long
Dim Dico As Object
Set Dico = CreateObject("Scripting.Dictionary")
Dico.CompareMode = 1

depart = Now

    critere = Range("T2:T" & Range("B" & Rows.Count).End(xlUp).Row).Value
    critere2 = Range("G2:G" & Range("G" & Rows.Count).End(xlUp).Row).Value

    ReDim resultat(1 To UBound(critere), 1 To 1)

    For i = 1 To UBound(critere)

        If Not Dico.exists(critere2(i, 1)) Then
            If Not Dico.exists(critere(i, 1)) Then resultat(i, 1) = 1 Else resultat(i, 1) = 0
        Else
            resultat(i, 1) = 0
        End If
        Dico(critere(i, 1)) = 1

    Next
    Range("AK2:AK" & Range("G" & Rows.Count).End(xlUp).Row).Value = resultat

MsgBox Format(Now - depart, "hh:mm:ss")

End Sub

Il y a combien de 0 au final dans la formule ? 7 ou 6

La seconde formule en question est

SI([@[DESCR_LOGEMENT]]="0000000";0;SI(NB.SI($X$1:X2;$X2)>1;0;1))

. Et doit se retrouver dans la colonne AK.

la formule exacte est :

SI($G1="000000";0;SI(NB.SI($X$1:X2;$X2)>1;0;1))

pour la colone AK2 jusqu'à la dernière ligne non vide.

je propose la correction suivante de la macro de Baboutz (pour moi, le test sur critere2 est de savoir s'il est égal à 000000 ou 0000000, il ne rentre dans pas le dictionnaire).

Sub version_v3()

Dim critere1 As Variant, critere2 As Variant, resultat As Variant, i As Long
Dim Dico As Object
Set Dico = CreateObject("Scripting.Dictionary")
Dico.CompareMode = 1

depart = Now

    critere1 = Range("X2:X" & Range("B" & Rows.Count).End(xlUp).Row).Value
    critere2 = Range("G2:G" & Range("B" & Rows.Count).End(xlUp).Row).Value

    ReDim resultat(1 To UBound(critere1), 1 To 1)

    For i = 1 To UBound(critere1)

        If Not Dico.exists(critere1(i, 1)) Then resultat(i, 1) = IIf(critere2(i, 1) = "000000", 0, 1) Else resultat(i, 1) = 0
        Dico(critere1(i, 1)) = 1

    Next
    Range("AK2:AK" & Range("B" & Rows.Count).End(xlUp).Row).Value = resultat

MsgBox Format(Now - depart, "hh:mm:ss")

End Sub

Bonjour cher forum, Baboutz et Steelson,

J'espère que vous avez passez un bon week-end.

Je ne suis pas certain de bien saisir la dernière solution de Steelson!

Pour mon besoin, il s'agit d'appliquer deux formules indépendantes l'une de l'autre :

Formule 1 : =SI(NB.SI($T$1:$T2;$T2)=1;1;0) pour la colonne AL2 jusqu'à la dernière ligne non vide,

et

Formule 2 : SI($G1="0000000";0;SI(NB.SI($X$1:X2;$X2)>1;0;1)) pour la colonne AK2 jusqu'à la dernière ligne non vide.

(Désolé, il y a sept zéro)

Est-ce que la dernière proposition fait ça?

Merci encore pour votre aide, bonne semaine.

Non, il faut cumuler les 2 formules ... je vais te le faire !

Option Explicit

Sub version_v5()
Dim critere0 As Variant, resultat1 As Variant
Dim critere1 As Variant, critere2 As Variant, resultat2 As Variant
Dim i As Long, n As Long, depart As Date
Dim Dico1 As Object, Dico2 As Object
Set Dico1 = CreateObject("Scripting.Dictionary")
Dico1.CompareMode = 1
Set Dico2 = CreateObject("Scripting.Dictionary")
Dico2.CompareMode = 1

depart = Now

    n = Range("B" & Rows.Count).End(xlUp).Row
    critere0 = Range("T2:T" & n).Value
    critere1 = Range("X2:X" & n).Value
    critere2 = Range("G2:G" & n).Value
    ReDim resultat1(1 To n - 1, 1 To 1)
    ReDim resultat2(1 To n - 1, 1 To 1)
    For i = 1 To n - 1
        If Not Dico1.exists(critere0(i, 1)) Then resultat1(i, 1) = 1 Else resultat1(i, 1) = 0
        Dico1(critere0(i, 1)) = 1
        If Not Dico2.exists(critere1(i, 1)) Then resultat2(i, 1) = IIf(critere2(i, 1) = "0000000", 0, 1) Else resultat2(i, 1) = 0
        Dico2(critere1(i, 1)) = 1
    Next
    Range("AL2:AL" & n).Value = resultat1
    Range("AK2:AK" & n).Value = resultat2

MsgBox Format(Now - depart, "hh:mm:ss")

End Sub
3vdmichel-v5.xlsm (16.86 Ko)

Bonjour Steelson,

WOW, c'est du costaud votre code. Merci beaucoup.

Je vous joins un extrait du fichier (que j'aurais du le poster dès le départ - désolé pour ça). L'original a plus de 145 000 lignes, et en aura de plus en plus avec le temps.

Bref, si vous pouviez me confirmer que le code exécute bien le traitement des deux formules (voir colonnes AP2 et AQ2).

Merci encore pour votre indispensable aide.

7salub.xlsm (64.13 Ko)

Justement, j'allais te poser la même question.

Hé bien, OUI.

J'ai mis tes formules dans des nouvelles colonnes et j'ai comparé les résultats. C'est impeccable !

Bonjour Steelson,

Merci tout.

A+

Rechercher des sujets similaires à "macro 145 000 lignes"