Macro suppression sur plusieurs classeurs

[mika909]

Bonjour tout le monde. Je cherche à créer une macro pour excel 2010 mais je patauge (pas expert en macros).

Voici mon souci :

Je possède 3 classeurs qui possèdent beaucoup de lignes sur 1 colonne.

classeur 1 : 575.000 lignes en colonne A
classeur 2 : 700.000 lignes en colonne A
classeur 3 : 350.000 lignes en colonne A

Les données du classeur 3 sont des références à supprimer dans les classeurs 1 et 2. Ces références sont soit dans un classeur soit dans l'autre. Optionnellement, il ne faudrait pas supprimer les valeurs du classeur 3.

Est-il possible de faire cela par macro, je suppose mais je ne trouve pas la solution.

Merci de votre aide et de vos solutions.

Michaël.

 

[néné06]

Re : Macro suppression sur plusieurs classeurs

Re,

supprimes les deux premieres lignes,

option explicite

option base 1

A+

René

 

[mika909]

Re : Macro suppression sur plusieurs classeurs

Merci, j'ai lancé le traitement, cela tourne depuis 15mn, je te tiens au jus si cela fonctionne.

Merci.

Michaël

 

[mika909]

Re : Macro suppression sur plusieurs classeurs

Bonjour Néné, cela n'a pas fonctionné, cela a tourné toute la nuit et Excel ne répondait plus.

A+

 

[néné06]

Re : Macro suppression sur plusieurs classeurs

Bonjour Michaël,

Si tu pouvais tester avec ton fichier, dans un premier temps, en ne plaçant "que 10000 lignes dans chaque feuilles" ?

Tu verras si erreur il y a ?

A+

René

 

[mika909]

Re : Macro suppression sur plusieurs classeurs

Cela n'a rien changé, cela a bloqué au bout de 2mn, voici le fichier que j'ai testé avec 10.000 lignes par feuille si cela peut t'aider à voir le souci.

Merci.

A+
Michaël.

 

[néné06]

Re : Macro suppression sur plusieurs classeurs

Re,

voici le fichier que j'ai testé avec 10.000 lignes
Michaël.

Je ne vois pas de fichier ?

A+

René

 

[mika909]

Re : Macro suppression sur plusieurs classeurs

Désolé, le fichier est trop gros, il ne passe pas, tu peux le récupérer à cette adresse :

Merci.

A+

 

[néné06]

Re : Macro suppression sur plusieurs classeurs

Bonjour le Forum,
Salut Michaël

J'ai changé le système de travail.
Regardes cet exemple qui travail en 37 secondes pour 10000 lignes avec visualisation de la ligne traitée.
Tu passerais en 29 secondes si tu enlèves cette instruction qui permet de savoir la ligne traitée

Sub traiter()
    Dim d As Variant
    t = Timer
    'Tri par alpha les trois feuilles
    Sheets("Feuil1").Select

       i = 1
        Do Until Cells(i, 1) = ""
            i = i + 1


            Cells(1, 9) = i 


            d = Application.Match(Cells(i, 1), Range("B:B"), 0)
                If IsNumeric(d) Then
                Cells(d, 2) = ""
                Else
                    d = Application.Match(Cells(i, 1), Range("C:C"), 0)
                        If IsNumeric(d) Then
                            Cells(d, 3) = ""
                        End If
                End If
        Loop

    MsgBox "Traitement Terminé " & Format(Timer - t, "0.00 s"), , "Fin du traitement"
End Sub

Regardes et dis-nous ?


A+

René

 

[mika909]

Re : Macro suppression sur plusieurs classeurs

Merci Néné.

Cela fonctionne très bien avec les valeurs du fichier joint, mais dès que je mets mes 3 bases ou d'autres valeurs cela ne fonctionne pas.

Cela ne supprime pas les valeurs des colonnes B et C et déplace celles de la colonne A, c'est bizarre. Voici 2 captures qui te montrent ce que cela fait.





A+

 

[néné06]

Re : Macro suppression sur plusieurs classeurs

Re,

Alors là, je ne comprends pas ?
La colonne A, n'est jamais sollicité par la macro, mis à part le simple tri du départ ??

Aurais tu d'autres macros dans ton programme ??

A+

René

 

[mika909]

Re : Macro suppression sur plusieurs classeurs

Non, je n'ai pas d'autres macros. J'ai réutilisé ton fichier joint.

 

[néné06]

Re : Macro suppression sur plusieurs classeurs

Re,

Je te fais parvenir la dernière mouture, avec toutes les explications .

Toutes ces explications te permettront de mieux comprendre le code et peut-être, de le modifier à ta convenance ?

[CODE]Sub traiter()
    Dim d As Variant 'variable numeric ou alphanumeric
    t = Timer ' depart du chrono
    Columns("A:A").Select ' Selection de toute la colonne A
    'Tri la colonne A par ordre alphanumeric
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    'Départ à la ligne 1
       i = 1
        Do Until Cells(i, 1) = "" ' Revient tant que espace blanc pas trouvé
            i = i + 1 'augmente la ligne de travail de 1 pour passer à la ligne suivante
            Cells(1, 9) = i 'Affiche en $I$1 le numéro de la ligne traitée
            d = Application.Match(Cells(i, 1), Range("B:B"), 0) ' Recherche en colonne B la valeur de la cellule colonne A de la ligne traitée
                If IsNumeric(d) Then 'Si recherche dans la col A du numero (i)de la ligne trouvé en col B alors
                    Cells(d, 2) = "" 'Efface la cellule ligne trouvée en colonne B
                Else 'Sinon
                    d = Application.Match(Cells(i, 1), Range("C:C"), 0) ' Recherche en colonne C la valeur de la cellule colonne A de la ligne traitée
                        If IsNumeric(d) Then 'Si recherche dans la col A du numero (i)de la ligne trouvé en col C alors
                            Cells(d, 3) = "" 'Efface la cellule ligne trouvée en colonne C
                        End If 'fin
                End If 'fin de la recherche,la valeur de la cellule de la ligne i en colonne A , n'existe pas dans les colonnes B et C
        Loop 'Retour à Do until pour traiter la ligne suivante
    Columns("B:B").Select ' Selection de toute la colonne B
    'Tri la colonne B par ordre alphanumeric pour enlever les espaces blancs
    Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Columns("C:C").Select ' Selection de toute la colonne C
    'Tri la colonne C par ordre alphanumeric pour enlever les espaces blancs
    Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    'Fin du chrono et message
    MsgBox "Traitement Terminé " & Format(Timer - t, "0.00 s"), , "Fin du traitement"
End Sub 'Fin du sous programme

[/CODE]

Si tu as des questions, n'hésites pas !

A bientôt

René