VBA - Renvoyer une liste sans doublons à partir de deux feuilles

[lebast]

Bonjour à tous,

j'ai bien cherché une réponse sur le forum mais je n'en ai trouvé qu'une moitié ..

Voila mon problème, j'ai deux feuilles :
1 première liste sur la feuille 1 en colonne a
1 seconde liste sur la feuille 2 en colonne c

je souhaiterais renvoyer 1 et 1 seule liste surs la feuille 3 en colonne a sans doublons et si possible rangé par ordre alphabétique.

voila ce que j'ai réussi à faire mais cela ne fonctionne qu'avec une seule colonne :

Sub Filtrer()
With Worksheets("BD Import fichier report PRECHA")
With .Range("E1:E20000")
.AdvancedFilter xlFilterCopy, , Worksheets("Quantite produite").Range("B8"), True
End With
End With
End Sub

Merci pour l'aide que vous m'apporterez

Bastien

 

[BOISGONTIER]

Re : VBA - Renvoyer une liste sans doublons à partir de deux feuilles

Bonjour,


Fonction perso matricielle

-Sélectionner 20 cellules verticales
=fusion(Feuil1!A2:A6;Feuil2!C2:C5)
-Valider avec maj+ctrl+entrée

http://boisgontierjacques.free.fr/fichiers/Cellules/FusionTableaux.xls

JB

 

[lebast]

Re : VBA - Renvoyer une liste sans doublons à partir de deux feuilles

Bonjour,

Je risque d'avoir un nombre de ligne plus que conséquent, la formule matricielle est elle capable de gérer 2 listes de 4000 lignes ?

Merci pour votre retour

 

[phlaurent55]

Re : VBA - Renvoyer une liste sans doublons à partir de deux feuilles

Bonjour à tous,

une solution par macro

à+
Philippe

 

[BOISGONTIER]

Re : VBA - Renvoyer une liste sans doublons à partir de deux feuilles

>Je risque d'avoir un nombre de ligne plus que conséquent, la formule matricielle est elle capable de gérer 2 listes de 4000 lignes ?

Il n'y a pas plus rapide (0,12sec pour fusion de 2 listes avec 10.000 items - 0,07 sec pour 2 listes de 4.000 items)

=fusion(Feuil1!A2:A10000;Feuil2!C2:C10000)

JB

 

[lebast]

Re : VBA - Renvoyer une liste sans doublons à partir de deux feuilles

Merci pour vos retours,

@BOISGONTIER, j'ai copié la macro présente de votre fichier, mais quand je réalise la formule j'obtiens le résultat #VALEURS, pourriez vous m'aider sur ce point la ?

D'autre part, on dirait que toute vos formules sont liées dans les cellules jaunes, comment faites vous ?

Merci pour vos retours

Bastien

 

[BOISGONTIER]

Re : VBA - Renvoyer une liste sans doublons à partir de deux feuilles

-Sélectionner A2:A8000
=fusion(Feuil1!A2:A4000;Feuil2!C2:C4000)
-Valider avec maj+ctrl+entrée


JB

 

[lebast]

Re : VBA - Renvoyer une liste sans doublons à partir de deux feuilles

j'ai encore #valeurs en résultat .. je comprends pas

je vous joins le fichier au cas ou ..

Merci d'avance !

 

[BOISGONTIER]

Re : VBA - Renvoyer une liste sans doublons à partir de deux feuilles

Quel est le mot de passe?

JB

 

[lebast]

Re : VBA - Renvoyer une liste sans doublons à partir de deux feuilles

Voila le fichier sans MDP

Désolé !

 

[BOISGONTIER]

Re : VBA - Renvoyer une liste sans doublons à partir de deux feuilles

-Il n'y avait pas assez de lignes sélectionnées pour la formule
-J'ai désactivé le WorkBook_Open() qui appelle un Userform1 inexistant
-Si une modification a lieu dans une des feuilles sources, le résultat est maj automatiquement.

JB

 

[DoubleZero]

Re : VBA - Renvoyer une liste sans doublons à partir de deux feuilles

Bonjour, lebast, Philippe , BOISGONTIER , le Forum,

Une autre suggestion :

Option Explicit
Sub Zéro_doublon()
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    Sheets("listesansdoublons").Columns(1).Clear
    Sheets("Extraction expédition").Columns(3).SpecialCells(xlCellTypeConstants, 23).Copy Destination:=Sheets("listesansdoublons").[a2]
    Sheets("Extraction production").Columns(4).SpecialCells(xlCellTypeConstants, 23).Copy Destination:=Sheets("listesansdoublons").Range("a" & Rows.Count).End(xlUp)(2)
    With Sheets("listesansdoublons").Range("a:a")
        .RemoveDuplicates Columns:=1, Header:=xlNo
        .Sort .Range("a2"), xlAscending, Header:=xlNo
    End With
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

A bientôt