J'ai 1 liste & je compar sur 3 autres listes

Résolu
nadine258 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention   -  
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

J'ai quelques difficultés à réaliser mon module en VBA . Le sujet est : je suis sur le même classeur, dans un feuillet
Sheets("contenu a traiter"). 'la liste que je dois contrôler (col B1:B90)
le deuxième feuillet Sheets("Liste existant"). 'composé de 3 listes (A1:a45) ; (D1:D45) ; et ("$G$1:$G$25") ce qui fait ("$A$1:$G$25")

je traite le fichier "contenu a traiter" par boucle For i = 1 To 150 'liste a traiter
et je déclare 3 indices DIM b, e, h ==> déjà une erreur
je place des filtres sur chaque colonne pour traiter chacune des listes
ActiveSheet.Range("$A$1:$A$25").AutoFilter Field:=1, Criteria1:=("B" & i)
ActiveSheet.Range("$D$1:$D$45").AutoFilter Field:=4, Criteria1:=("B" & i)
ActiveSheet.Range("$G$1:$G$18").AutoFilter Field:=7, Criteria1:=("B" & i)

et suivant chaque AutoFilter le pavé de copie dans la colonne voisine si A copie dans B, si D copie dans E etc...
déjà comment rendre indépendant chacune des sélection et le add 1 to b ne marche pas !!
then
add 1 to b
Range("B" & i).Select
ActiveSheet.Paste
Sheets("contenu a traiter").Select
Range("G" & h).Select
Application.CutCopyMode = False
Selection.Copy

Je cherche à bien décomposer sur chaque filtre car j'ai une autre procédure a écrire dans les mêmes principes.

Donc
je démarre sur For i et le If (i, 1) < 150 Then est refusé
ensuite ma gestion de boucle interne incrémenté me pose problème

Un petit coup de main serait drôlement sympa.
A voir également:

4 réponses

f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 715
 
Bonjour,
Pouvez vous exposer ce que vous voulez faire sans parler programmation, parce que je ne comprends pas vos explications

A+
0
nadine258 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
 
Je part d'une liste de nom sur 1 colonne et dans le feuillet suivant je vérifie si dans mes 3 listes de nom (A, D, G) j'ai ce nom. Si oui je recopie le nom dans une colonne suivante de la liste correspondante (B ou E ou H). Si non je recopie le nom dans la colonne J.

Merci.
0
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 276
 
Bonjour,

tu peux déposer un fichier exemple sur cjoint.com et coller ici le lien fourni.
eric
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 715
 
Bonjour,

Un exmple de programmation.
Code a mettre dans un module ou ThisWorbook.

Sub Traitement_Liste() 
  Dim PlageB As Range, cel As Range, derligJ, derlig 
  Dim PlageA As Range, PlageD As Range, PlageG As Range 
   
  Application.ScreenUpdating = False 
  'Liste a traiter 
  Set PlageB = Worksheets("contenu a traiter").Range("B1:B90") 
    For Each cel In PlageB 
      With Worksheets("Liste existant") 
        'Listes a comparer 
        Set PlageA = .Range("A1:A25") 
        Set PlageD = .Range("D1:D25") 
        Set PlageG = .Range("G1:G25") 
        'Test si presence 
        NbrA = Application.CountIf(PlageA, cel) 
        NbrD = Application.CountIf(PlageD, cel) 
        NbrG = Application.CountIf(PlageG, cel) 
        If NbrA > 0 Then 
          Lig = .Columns("A").Find(cel, .Cells(1, "A"), , xlWhole).Row 
          'pour la dernière ligne de la colonne B 
          derlig = .Cells(Rows.Count, "B").End(xlUp).Row 
          If .Cells(1, "B") <> "" Then 
            derlig = derlig + 1 
          End If 
          'Ecriture colonne +1 
          .Cells(derlig, "B") = cel 
        ElseIf NbrD > 0 Then 
          Lig = .Columns("D").Find(cel, .Cells(1, "D"), , xlWhole).Row 
          'pour la dernière ligne de la colonne E 
          derlig = .Cells(Rows.Count, "E").End(xlUp).Row 
          'pour la premiere utilisation 
          If .Cells(1, "E") <> "" Then 
            derlig = derlig + 1 
          End If 
          'Ecriture colonne +1 
          .Cells(derlig, "E") = cel 
        ElseIf NbrG > 0 Then 
          Lig = .Columns("G").Find(cel, .Cells(1, "G"), , xlWhole).Row 
          'pour la dernière ligne de la colonne H 
          derlig = .Cells(Rows.Count, "H").End(xlUp).Row 
          'pour la premiere utilisation 
          If .Cells(1, "H") <> "" Then 
            derlig = derlig + 1 
          End If 
          'Ecriture sur meme ligne colonne +1 
          .Cells(derlig, "H") = cel 
        Else 
          'pour la dernière ligne de la colonne J 
          derligJ = .Range("J" & Rows.Count).End(xlUp).Row 
          'pour la premiere utilisation 
          If .Range("J1") <> "" Then 
            derligJ = derligJ + 1 
          End If 
          'Ecriture non trouve 
          .Range("J" & derligJ) = cel 
        End If 
      End With 
    Next cel 
  Application.ScreenUpdating = True 
End Sub
0
Nadine258
 
Bonjour,

Je reviens vers vous que j'ai utilisé le module dans un autre fichier et il ne me traite que la dernière ligne. J'ai pourtant fait l'insertion par module que si pas module il ne reconnait pas les Lig donc ce pourrait être le paramètre ThisWorbook.
Je ne sais comment le placer et quelle est sa syntaxe ? Si vous pouvez me donner cette précision je vous en remercie.
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 715
 
Bonjour,

Les Onglets ont les memes noms
Les plages de listes a comparer sont les memes??
0
nadine258 Messages postés 8 Date d'inscription   Statut Membre Dernière intervention  
 
Merci f894009 ton programme est nickel.
ça me change des journées passées à décortiquer ma programmation. Bon dimanche.
0