Boucle pour recherche de données entre 2 feuilles

Bonjour le forum

J’ai une base de données qui varie tout le temps (nbr de ligne). Comme vous pouvez le constater, il y a énormément de lignes

Je cherche à réorganiser ces données en fonction d’une échelle définie comme suit :

N° NRO - Nul ou rien – NRO – PEP – PDZ ou PEZ – PE ou PR ou PMZ – PA ou PMR ou PMI - PB

Le problème c’est que ces données sont en zig-zag

J’explique :

les PB sont les fils soit des (PA, PMR, PMI),

qui sont les fils soit des (PE,PR, PMZ),

qui sont les fils soit des (PDZ, PEZ),

qui sont les fils soit des( PEP),

qui sont les fils des (NRO),

qui sont les fils soit des( Nul ou Rien),

qui sont les fils des (N° NRO),

le tout étant reclasser en fonction du « code_com » faisant parti du dept

Ce que je cherche à faire c'est rechercher à partir de la feuille "Final" la correspondance des valeurs de la colonne "N" dans la feuille "PF" colonne "$H", la valeur de la colonne à gauche donc en "$G" et aller la coller à gauche de la colonne "M" de la feuille "Final" , puis recommencer colonne par colonne Si il y à quelque chose

Exemple : "PA 181" en "N" dans "Final", rechercher dans "PF" en "H", puis copier "PMZ 16" dans "Final" colonne

Une fois passer toute la colonne "N" de la feuille "Final", recommencer avec la colonne "M"

Je joint un fichier

je vous remercie d'avance pour votre aide et votre disponibilité

Bonjour,

un proposition

Sub aargh()
sheets("final").select
    For c = 14 To 4 Step -1 'on prend les colonnes N à D
        For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'on parcourt toutes les lignes de la colonne c
            Set re = Sheets("pf").Columns("H").Find(Cells(i, c), lookat:=xlWhole) 'on recherche dans PF en colonne H, le contenu de la cellule (i,c), il faut une correspondance exacte (xlwhole)
            If Not re Is Nothing Then 'si on a trouvé le contenu
                Cells(i, c - 1) = re.Offset(0, -1) 'on prend le contenu de la cellule  de la colonne précédente sur la même ligne
            End If
        Next i
    Next c
End Sub

Bonjour h2so4

Merci pour ta réactivité et ton aide

c'est super, mais j'ai fais une petite omission ou peut être le code va trop loin dans les colonnes.

Il ne faut pas toucher ou s'arrêté à la colonne "C" qui correspond aux Codes de la dernière colonne "O"

En plus j'aimerai bien comprendre ce que tu as fais, comment tu monte un code comme ça STP

Que veut dire "For c = 14 To 4 Step -1", "lookat:=xlWhole", re.Offset(0, -1)?

Merci pour ton aide

J'ai documenté mon code dans mon message précédent.

Merci beaucoup pour ton aide et tes commentaires

je clôture ça fonctionne impec

Bonsoir le forum

Je suis désolé de déterrer le post, mais j'ai besoin d'une évolution du code que h2so4 m'a écrit.

Dans le code, à la ligne 7, on copie la cellule à gauche de celle trouvé, comme je dois écrire si je veux copier les deux cellules se trouvant à gauche?

Avec le fichier fourni , je voudrai copier les cellules des colonnes "G" et "F"

D'avance je vous remercie pour votre aide et votre disponibilité

Bonjour,

où faut-il copier ces 2 valeurs ? dans ton tableau tel qu'il se présente, il n'y aura pas toujours la place pour cette copie.

Sub aargh()
Sheets("final").Select
    For d = 14 To 6 Step -2 'on prend les colonnes N à D
     If d <> 14 Then c = d + 1 Else c = d
     For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'on parcourt toutes les lignes de la colonne c
           Set re = Sheets("pf").Columns("H").Find(Cells(i, c), lookat:=xlWhole) 'on recherche dans PF en colonne H, le contenu de la cellule (i,c), il faut une correspondance exacte (xlwhole)
           If Not re Is Nothing Then 'si on a trouvé le contenu
               If d <> 14 Then
                              Cells(i, c - 2) = re.Offset(0, -1) 'on prend le contenu de la cellule  de la colonne précédente sur la même ligne
           Cells(i, c - 3) = re.Offset(0, -2)
           Else
               Cells(i, c - 1) = re.Offset(0, -1) 'on prend le contenu de la cellule  de la colonne précédente sur la même ligne
           Cells(i, c - 2) = re.Offset(0, -2)
           End If
           End If

        Next i
    Next d
End Sub

Bonsoir le forum

Bonsoir h2so4

merci pour ta disponibilité

Ben justement j'étais entrai de me dire que ce serait bien de créer les colonnes en même temps que d'importer les résultats de la recherche.

Bonsoir,

une proposition

Sub aargh()
Sheets("final").Select
dc = Cells(1, Columns.Count).End(xlToLeft).Column 'dc dernière colonne utilisée en ligne 1
While dc > 1
 If Cells(1, dc) = "" Then Columns(dc).Delete shift:=xlToLeft :' suppression des colonnes avec un titre vide
dc = dc - 1
Wend
    relationexists = True
    fr = True
    While relationexists ' tant qu'il y a au moins une relation pere fils
   If fr Then c = 6 Else c = 7
     Columns("D:E").Insert shift:=xlToRight ' on ajoute 2 colonnes
    relationexists = False
     For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'on parcourt toutes les lignes de la colonne c
         If Cells(i, c) <> "" Then
          Set re = Sheets("pf").Columns("H").Find(Cells(i, c), lookat:=xlWhole) 'on recherche dans PF en colonne H, le contenu de la cellule (i,c), il faut une correspondance exacte (xlwhole)
         If Not re Is Nothing Then 'si on a trouvé le contenu
             relationexists = True
              If Not fr Then
                              Cells(i, c - 2) = re.Offset(0, -1) 'on prend le contenu de la cellule  de la colonne précédente sur la même ligne
         Cells(i, c - 3) = re.Offset(0, -2)
           Else
               Cells(i, c - 1) = re.Offset(0, -1) 'on prend le contenu de la cellule  de la colonne précédente sur la même ligne
         Cells(i, c - 2) = re.Offset(0, -2)
           End If
           End If
           End If
        Next i
        fr = False
    Wend
    Columns("d:e").Delete shift:=xlToLeft
    MsgBox ("terminé")
End Sub

Bonjour le forum

Bonjour h2so4

J'ai essayé ton nouveau code.

Ca devrait fonctionner, mais comme j'ai été obligé de modifié le tableau contenant les données à importer, je fournis en pièce jointe une autre version de mon fichier.

Merci de ton aide et de ta disponibilité

bonjour,

un nouvelle version

Sub aargh()
    Sheets("final").Select
    relationexiste = True
    c = 7
    While relationexiste
    Columns("D:E").Insert shift:=xlToRight    ' on ajoute 2 colonnes
    relationexiste = False
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row    'on parcourt toutes les lignes de la colonne c
        If Cells(i, c) <> "" Then
            Set re = Sheets("pf").Columns("G").Find(Cells(i, c), lookat:=xlWhole)    'on recherche dans PF en colonne G, le contenu de la cellule (i,c), il faut une correspondance exacte (xlwhole)
            If Not re Is Nothing Then    'si on a trouvé le contenu
                relationexiste = True
                Cells(i, c - 2) = re.Offset(0, -2)    'on prend le contenu de la cellule  de la colonne situé 2 positions à gauche sur la même ligne
                Cells(i, c - 3) = re.Offset(0, -3)
            End If
        Next i
    Wend
    Columns("d:e").Delete shift:=xlToLeft
    MsgBox ("terminé")
End Sub

Merci h2so4

il a fallu que je rajoute un "End If" mais sa fonctionne impec

Merci pour ton aide et ta disponibilité

Bonsoir le forum

Bonsoir h2so4

Dis moi vu la feuille "Final1" (cette usine à gaz lol) est ce qu'il y aurait pas possibilité d'organiser un tri pour ordonnée les données et puis après fusionner les cellules?( je sais personne n'aime les fusion de cellules mais la c'est pour la lisibilité)

Merci pour ton aide