VBA - Recherche sur colonnes de Gauche

Le 30/06/2019 à 00:07

Bonsoir,

Pour effectuer des recherches dans mon document, j'avais fait un code qui recherchait les valeurs présentes dans certaines colonnes de ma feuille de travail sur deux autres feuilles de manière à regrouper toutes les informations dont il a besoin pour poursuivre.

Pour pallier au problème de recherche sur la droite ou sur la gauche, j'avais une ligne qui déplaçait la colonne où sont effectuées les recherches tout à gauche de manière à ce que les recherches se fasses à droite. Cela fonctionnait avec une source de données unique ; mais je vais avoir besoin de regrouper "x" sources de donnée à des moments différents et je ne veux plus déplacer les colonnes autrement ça rend les choses autrement plus compliquées et va me contraindre à rajouter des calculs pour rien.

Tout d'abord, voici le code que j'utilise :

Option Explicit

Dim n As String, Rep As Byte
Dim lrfb As Long, lrco As Long, lrsa As Long, lrdc As Long, r As Long
Dim fb As Worksheet, sa As Worksheet, dc As Worksheet, ds As Worksheet, co As Worksheet
Dim rng As Range, cell As Range, rng2 As Range, Cell2 As Range
Dim i&, derLn&, nb&, derLn2&, nb2&
Dim del As Integer

Sub recherche()
Set fb = Worksheets("Formulaire bota")
Set sa = Worksheets("Saisie")
Set co = Worksheets("Correspondances")

        Dim Lig As Long
        Dim Col As String
        Dim NbrLig As Long
        Dim NumLig As Long

            co.Cells(1, 1).Value = sa.Cells(1, 1).Value
            co.Cells(1, 2).Value = fb.Cells(1, 4).Value
            co.Cells(1, 3).Value = sa.Cells(1, 4).Value
            Cells(1, 4).Value = "Correspondance"
            co.Cells(1, 5).Value = sa.Cells(1, 5).Value
            co.Cells(1, 6).Value = sa.Cells(1, 6).Value
            co.Cells(1, 7).Value = fb.Cells(1, 5).Value
            co.Cells(1, 8).Value = fb.Cells(1, 6).Value
            co.Cells(1, 9).Value = fb.Cells(1, 16).Value
            co.Cells(1, 10).Value = fb.Cells(1, 17).Value
            co.Cells(1, 11).Value = fb.Cells(1, 12).Value
            co.Cells(1, 12).Value = fb.Cells(1, 13).Value

                lrfb = fb.Cells(Rows.Count, 1).End(xlUp).Row
                lrsa = sa.Cells(Rows.Count, 1).End(xlUp).Row

                Dim vari As Range, plge As Range

                'Remplissage de la colonne [A] (Parrent row ID)
                'Remplissage de la colonne [C] (espece)
                     With sa
                        'dernière ligne non vide de la colonne A
                        lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row
                        'Plage à copier
                        Set rng = .Cells(1, 1).Resize(lrsa + 1)
                        Set rng2 = .Cells(1, 4).Resize(lrsa + 1)
                    End With

                    With co
                        'dernière ligne non vide de la colonne A
                        lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row
                        Set cell = .Cells(lrsa, 1)
                        Set Cell2 = .Cells(lrsa, 3)
                    End With

                    rng.Copy Destination:=cell
                    rng2.Copy Destination:=Cell2

                    With co
                        'dernière ligne non vide de la colonne A
                        lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                        'plage de cellules
                        Set rng = .Cells(1, 1).Resize(lrsa - 1)
                        Set rng2 = .Cells(1, 3).Resize(lrsa - 1)
                    End With

                'Remplissage de la colonne [B] (Numéro étude)
                Dim i1 As Integer, num1 As Variant
                With Worksheets("Correspondances")
                lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
                For i1 = 2 To lrco
                On Error Resume Next
                  num1 = Application.WorksheetFunction.VLookup(.Cells(i1, 1), Sheets("Formulaire bota").Range("A:D"), 4, 0)
                  .Cells(i1, 2) = IIf(IsError(num1), 0, num1)
                Next
                End With

                'Conserver les valeurs recherchées (num étude)
    '                With co
    '                    For del = co.Range("B" & .Rows.Count).End(xlUp).Row To 2 Step -1
    '                        If .Range("B" & del).Value <> n Then
    '                        .Rows(del).Delete
    '                        End If
    '                    Next del
    '                End With

                'Remplissage de la colonne [E] (abondance)
                'Remplissage de la colonne [F] (remarque)
                'Remplissage de la colonne [C] (especes) (désactivé)
                Dim i2 As Integer, num2 As Variant, num3 As Variant, num4 As Variant
                    With Worksheets("Correspondances")
                        lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
                        For i2 = 2 To lrco
                        On Error Resume Next
                            num2 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("saisie").Range("A:E"), 5, 0)
                            .Cells(i2, 5) = IIf(IsError(num2), 0, num2)
                            num3 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("saisie").Range("A:F"), 6, 0)
                            .Cells(i2, 6) = IIf(IsError(num3), 0, num3)
                            'num4 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("saisie").Range("A:D"), 4, 0)
                            '.Cells(i2, 3) = IIf(IsError(num4), 0, num4)
                        Next
                    End With

                'Remplissage de la colonne [G] (cortege)
                'Remplissage de la colonne [H] (autres_infos)
                'Remplissage de la colonne [I] (x)
                'Remplissage de la colonne [J] (y)
                'Remplissage de la colonne [K] (created_date)
                'Remplissage de la colonne [L] (created_user)
                Dim num5 As Variant, num6 As Variant, num7 As Variant, num8 As Variant, num9 As Variant, num10 As Variant

                    With Worksheets("Correspondances")
                        For i2 = 2 To lrco
                        co.Cells(i2, 11).NumberFormat = "dd/mm/yyyy;@"
                        co.Cells(i2, 10).NumberFormat = "General"
                        co.Cells(i2, 2).NumberFormat = "@"

                        On Error Resume Next
                            num5 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:E"), 5, 0)
                            .Cells(i2, 7) = IIf(IsError(num5), 0, num5)
                            num6 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:F"), 6, 0)
                            .Cells(i2, 8) = IIf(IsError(num6), 0, num6)
                            num7 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:G"), 7, 0)
                            .Cells(i2, 11) = IIf(IsError(num7), 0, num7)
                            num8 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:M"), 13, 0)
                            .Cells(i2, 12) = IIf(IsError(num8), 0, num8)
                            num9 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:P"), 16, 0)
                            .Cells(i2, 9) = IIf(IsError(num9), 0, num9)
                            num10 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:Q"), 17, 0)
                            .Cells(i2, 10) = IIf(IsError(num10), 0, num10)
                        Next
                    End With
End Sub

Comme vous pouvez le voir, je lance toujours la recherche depuis la [colonne A].

Etant donné que je voudrais éviter la création d'un nouveau tableau, je cherche à faire la même chose mais avec des recherches sur la gauche.

En l'occurrence, dans la feuille "nouvelle saisie" la [colonne A] ("parentrowid") se retrouve en [colonne F].

Le but est de rechercher la valeur inscrite dans la "feuille Correspondances" en Cells(i2, 1) |i2 = 2 To dernière ligne| dans la feuille "nouvelle saisie" [Colonne F] et de récupérer les informations présentes en [Colonnes C ; D et E].

Est-ce que la méthode que j'emploie peut être adaptée à cette situation ? De ce que je comprend il semble que ce ne soit pas possible ; mais peut-etre en utilisant find ?

J'ai ajouté un document Excel qui permet d'exécuter le code qui fonctionne actuellement sur mes anciennes sources de données.

J'espère qu'il ne faudra pas recommencer tout le code

Bonne soirée / nuit ! Je vais continuer à chercher un peu.

A plus tard !

26fonction-recherche.xlsm (41.00 Ko)
Le 30/06/2019 à 11:04

bonjour,

à tester

Sub recherche()
    Set fb = Worksheets("Formulaire bota")
    Set sa = Worksheets("Saisie")
    Set co = Worksheets("Correspondances")

    Dim Lig As Long
    Dim Col As String
    Dim NbrLig As Long
    Dim NumLig As Long
    Dim plagebota As Range, plagesaisie As Range, re As Range

    co.Cells(1, 1).Value = sa.Cells(1, 1).Value
    co.Cells(1, 2).Value = fb.Cells(1, 4).Value
    co.Cells(1, 3).Value = sa.Cells(1, 4).Value
    Cells(1, 4).Value = "Correspondance"
    co.Cells(1, 5).Value = sa.Cells(1, 5).Value
    co.Cells(1, 6).Value = sa.Cells(1, 6).Value
    co.Cells(1, 7).Value = fb.Cells(1, 5).Value
    co.Cells(1, 8).Value = fb.Cells(1, 6).Value
    co.Cells(1, 9).Value = fb.Cells(1, 16).Value
    co.Cells(1, 10).Value = fb.Cells(1, 17).Value
    co.Cells(1, 11).Value = fb.Cells(1, 12).Value
    co.Cells(1, 12).Value = fb.Cells(1, 13).Value

    lrfb = fb.Cells(Rows.Count, 1).End(xlUp).Row
    lrsa = sa.Cells(Rows.Count, 1).End(xlUp).Row

    Dim vari As Range, plge As Range

    'Remplissage de la colonne [A] (Parrent row ID)
    'Remplissage de la colonne [C] (espece)
    With sa
        'dernière ligne non vide de la colonne A
        lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row
        'Plage à copier
        Set rng = .Cells(1, 1).Resize(lrsa + 1)
        Set rng2 = .Cells(1, 4).Resize(lrsa + 1)
    End With

    With co
        'dernière ligne non vide de la colonne A
        lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set cell = .Cells(lrsa, 1)
        Set Cell2 = .Cells(lrsa, 3)
    End With

    rng.Copy Destination:=cell
    rng2.Copy Destination:=Cell2

    With co
        'dernière ligne non vide de la colonne A
        lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        'plage de cellules
        Set rng = .Cells(1, 1).Resize(lrsa - 1)
        Set rng2 = .Cells(1, 3).Resize(lrsa - 1)
    End With

    'Remplissage de la colonne [B] (Numéro étude)
    Dim i1 As Integer, num1 As Variant
    Set plagebota = fb.Range("A1:A" & fb.Cells(Rows.Count, 1).End(xlUp).Row)
    With Worksheets("Correspondances")
        lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
        For i1 = 2 To lrco
            Set re = plagebota.Find(.Cells(i1, 1), lookat:=xlWhole)
            If Not re Is Nothing Then
                .Cells(i1, 2) = re.Offset(, 3)
            Else
                .Cells(i1, 2) = 0    'numéro étude
            End If
            'num1 = Application.WorksheetFunction.VLookup(.Cells(i1, 1), Sheets("Formulaire bota").Range("A:D"), 4, 0)
            '.Cells(i1, 2) = IIf(IsError(num1), 0, num1)
        Next
    End With

    'Conserver les valeurs recherchées (num étude)
    '                With co
    '                    For del = co.Range("B" & .Rows.Count).End(xlUp).Row To 2 Step -1
    '                        If .Range("B" & del).Value <> n Then
    '                        .Rows(del).Delete
    '                        End If
    '                    Next del
    '                End With

    'Remplissage de la colonne [E] (abondance)
    'Remplissage de la colonne [F] (remarque)
    'Remplissage de la colonne [C] (especes) (désactivé)
    Dim i2 As Integer, num2 As Variant, num3 As Variant, num4 As Variant
    Set plagesaisie = sa.Range("A1:A" & sa.Cells(Rows.Count, 1).End(xlUp).Row)
    With Worksheets("Correspondances")
        lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
        For i2 = 2 To lrco
            Set re = plagesaisie.Find(.Cells(i2, 1), lookat:=xlWhole)
            If Not re Is Nothing Then
                .Cells(i2, 5) = re.Offset(, 4)    'abondance
                .Cells(i2, 6) = re.Offset(, 5)    'remarque
            Else
                .Cells(i2, 5) = 0
                .Cells(i2, 6) = 0
            End If
            'num2 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("saisie").Range("A:E"), 5, 0)
            '.Cells(i2, 5) = IIf(IsError(num2), 0, num2)
            'num3 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("saisie").Range("A:F"), 6, 0)
            '.Cells(i2, 6) = IIf(IsError(num3), 0, num3)
            'num4 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("saisie").Range("A:D"), 4, 0)
            '.Cells(i2, 3) = IIf(IsError(num4), 0, num4)
        Next
    End With

    'Remplissage de la colonne [G] (cortege)
    'Remplissage de la colonne [H] (autres_infos)
    'Remplissage de la colonne [I] (x)
    'Remplissage de la colonne [J] (y)
    'Remplissage de la colonne [K] (created_date)
    'Remplissage de la colonne [L] (created_user)
    Dim num5 As Variant, num6 As Variant, num7 As Variant, num8 As Variant, num9 As Variant, num10 As Variant

    With Worksheets("Correspondances")
        For i2 = 2 To lrco
            co.Cells(i2, 11).NumberFormat = "dd/mm/yyyy;@"
            co.Cells(i2, 10).NumberFormat = "General"
            co.Cells(i2, 2).NumberFormat = "@"
            Set re = plagebota.Find(.Cells(i2, 1), lookat:=xlWhole)
            If Not re Is Nothing Then
                .Cells(i2, 7) = re.Offset(, 4) 'cortège
                .Cells(i2, 8) = re.Offset(, 5) 'autres infos
                .Cells(i2, 11) = re.Offset(, 6) 'x
                .Cells(i2, 12) = re.Offset(, 12) 'y
                .Cells(i2, 9) = re.Offset(, 15) 'created_date
                .Cells(i2, 10) = re.Offset(, 16) 'created_user
            Else
                .Cells(i2, 7) = 0
                .Cells(i2, 8) = 0
                .Cells(i2, 11) = 0
                .Cells(i2, 12) = 0
                .Cells(i2, 9) = 0
                .Cells(i2, 10) = 0
            End If
            'num5 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:E"), 5, 0)
            '.Cells(i2, 7) = IIf(IsError(num5), 0, num5)
            'num6 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:F"), 6, 0)
            '.Cells(i2, 8) = IIf(IsError(num6), 0, num6)
            'num7 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:G"), 7, 0)
            '.Cells(i2, 11) = IIf(IsError(num7), 0, num7)
            'num8 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:M"), 13, 0)
            '.Cells(i2, 12) = IIf(IsError(num8), 0, num8)
            'num9 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:P"), 16, 0)
            '.Cells(i2, 9) = IIf(IsError(num9), 0, num9)
            'num10 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:Q"), 17, 0)
            '.Cells(i2, 10) = IIf(IsError(num10), 0, num10)
        Next
    End With
End Sub
Le 30/06/2019 à 11:19

Bonjour,

Merci pour votre réponse !

Pour le moment, il n'apparaît que des 0 dans les colonnes.

Je vais essayer de trouver d'où ça provient.

Surement cette partie là que je dois regarder en priorité

            Else
                .Cells(i2, 7) = 0
                .Cells(i2, 8) = 0
                .Cells(i2, 11) = 0
                .Cells(i2, 12) = 0
                .Cells(i2, 9) = 0
                .Cells(i2, 10) = 0

A plus tard

Le 30/06/2019 à 11:29

bonjour,

cela signifie que la valeur .cells(i2,1) n'a pas été trouvée. Peut-être une erreur dans ma correction, mais comme je ne sais pas ce que je dois faire pour vérifier le résultat, ...

Le 30/06/2019 à 11:32

Bonjour,

Ça vien très certainement de ma source de données ; le décalage d'une colonne entraîne le décalage des autres je n'y ai pas fait attention.. Je reviens dès que tout ça est modifié.

Le 30/06/2019 à 11:53

Dans cette partie du code il semble y avoir un problème :

With Worksheets("Correspondances")
        lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
        For i2 = 2 To lrco
            Set re = plagesaisie.Find(.Cells(i2, 6), lookat:=xlWhole)
            If Not re Is Nothing Then
                .Cells(i2, 5) = re.Offset(, 4)    'abondance
                .Cells(i2, 6) = re.Offset(, 5)    'remarque
            Else
                .Cells(i2, 5) = 0
                .Cells(i2, 6) = 0
            End If
        Next
    End With
            If Not re Is Nothing Then
                .Cells(i2, 5) = re.Offset(, 4)    'abondance
                .Cells(i2, 6) = re.Offset(, 5)    'remarque

Ici, lorsqu'on lance la macro étape par étape, le code saute cette partie et passe directement à Else. Il affiche donc des 0.

Si je survole re.Offset(, 4) il m'affiche dans une bulle : "Variable objet ou variable de bloc with non définie".

La variable re est pourtant bien définie.

Pour info, j'ai modifié cette ligne :

Set re = plagesaisie.Find(.Cells(i2, 6), lookat:=xlWhole)

Car la cellule à trouver ne se situe pas en [colonne A] mais en [colonne F].

Bonne journée !

Le 30/06/2019 à 12:09

Bonjour,

Ma contribution du jour.

De ce que j'ai compris !...

Cdlt.

9fonction-recherche.xlsm (28.85 Ko)
Sub recherche()
Dim lastRow As Long, lRow As Long
Dim rngFB As Range, rngSA As Range, rngCO As Range
Dim r

    Set fb = Worksheets("Formulaire bota")
    Set sa = Worksheets("Saisie")
    Set co = Worksheets("Correspondances")

    Set rngFB = fb.Cells(1).CurrentRegion
    Set rngSA = sa.Cells(1).CurrentRegion

    With sa.Cells(1).CurrentRegion
        Set rng = .Columns(1)
        Set rng2 = .Columns(4)
    End With

    With co
        .Cells(1).CurrentRegion.Offset(1).ClearContents
        rng.Copy Destination:=.Cells(1)
        rng2.Copy Destination:=.Cells(4)
        Set rng = Nothing: Set rng2 = Nothing
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For lRow = 2 To lastRow
            On Error Resume Next
            r = Application.VLookup(.Cells(lRow, 1), rngFB, 4, False)
            .Cells(lRow, 2) = IIf(IsError(r), 0, r)
            r = Application.VLookup(.Cells(lRow, 1), rngSA, 5, 0)
            .Cells(lRow, 5) = IIf(IsError(r), 0, r)
            r = Application.VLookup(.Cells(lRow, 1), rngSA, 6, 0)
            .Cells(lRow, 6) = IIf(IsError(r), 0, r)
            r = Application.VLookup(.Cells(lRow, 1), rngFB, 5, 0)
            .Cells(lRow, 7) = IIf(IsError(r), 0, r)
            r = Application.VLookup(.Cells(lRow, 1), rngFB, 6, 0)
            .Cells(lRow, 8) = IIf(IsError(r), 0, r)
            r = Application.VLookup(.Cells(lRow, 1), rngFB, 7, 0)
            .Cells(lRow, 11) = IIf(IsError(r), 0, r)
            r = Application.VLookup(.Cells(lRow, 1), rngFB, 13, 0)
            .Cells(lRow, 12) = IIf(IsError(r), 0, r)
            r = Application.VLookup(.Cells(lRow, 1), rngFB, 16, 0)
            .Cells(lRow, 9) = IIf(IsError(r), 0, r)
            r = Application.VLookup(.Cells(lRow, 1), rngFB, 17, 0)
            .Cells(lRow, 10) = IIf(IsError(r), 0, r)
        Next
        Set rngCO = .Cells(1).CurrentRegion
        With rngCO
            .Columns(11).NumberFormat = "dd/mm/yyyy;@"
            .Columns(10).NumberFormat = "General"
            .Columns(2).NumberFormat = "@"
        End With
    End With

End Sub
Le 30/06/2019 à 12:16
Le Drosophile a écrit :

Dans cette partie du code il semble y avoir un problème :

Ici, lorsqu'on lance la macro étape par étape, le code saute cette partie et passe directement à Else. Il affiche donc des 0.

Si je survole re.Offset(, 4) il m'affiche dans une bulle : "Variable objet ou variable de bloc with non définie".

La variable re est pourtant bien définie.

Pour info, j'ai modifié cette ligne :

Set re = plagesaisie.Find(.Cells(i2, 6), lookat:=xlWhole)

Car la cellule à trouver ne se situe pas en [colonne A] mais en [colonne F].

Bonne journée !

Bonjour,

A nouveau, si cette partie du code s'exécute c'est qu'il n'a pas trouvé .cells(i2,6) dans plagesaisie (ce qui est confirmé par ce message " "Variable objet ou variable de bloc with non définie". ". Donc vérifier plagesaisie et .cells(i2,6) et ensuite ajuster les décalages (offset) par rapport à la colonne 6 et non plus la colonne 1.

Le 30/06/2019 à 15:29

Bonjour,

Le problème venait finalement du fait que les données se situaient à gauche et non à droite (et également de plagesaisie effectivement qui correspondait à la colonne A et non à la colonne F)

La recherche se faisait [colonne 4] après 'plagesaisie'

Plage saisie se trouvant [colonne F], la recherche qui doit initialement se faire sur la [colonne D] se faisait sur la [colonne J].

J'ai donc donné des coordonnées négatives et tout s'exécute désormais correctement.

Voici le code complet :

Sub recherche()
    Set fb = Worksheets("Formulaire bota")
    Set sa = Worksheets("Saisie")
    Set co = Worksheets("Correspondances")

    Dim Lig As Long
    Dim Col As String
    Dim NbrLig As Long
    Dim NumLig As Long
    Dim plagebota As Range, plagesaisie As Range, re As Range

    co.Cells(1, 1).Value = sa.Cells(1, 6).Value
    co.Cells(1, 2).Value = fb.Cells(1, 4).Value
    co.Cells(1, 3).Value = sa.Cells(1, 3).Value
    Cells(1, 4).Value = "Correspondance"
    co.Cells(1, 5).Value = sa.Cells(1, 4).Value
    co.Cells(1, 6).Value = sa.Cells(1, 5).Value
    co.Cells(1, 7).Value = fb.Cells(1, 5).Value
    co.Cells(1, 8).Value = fb.Cells(1, 6).Value
    co.Cells(1, 9).Value = fb.Cells(1, 16).Value
    co.Cells(1, 10).Value = fb.Cells(1, 17).Value
    co.Cells(1, 11).Value = fb.Cells(1, 12).Value
    co.Cells(1, 12).Value = fb.Cells(1, 13).Value

    lrfb = fb.Cells(Rows.Count, 1).End(xlUp).Row
    lrsa = sa.Cells(Rows.Count, 1).End(xlUp).Row

    Dim vari As Range, plge As Range

    'Remplissage de la colonne [A] (Parrent row ID)
    'Remplissage de la colonne [C] (espece)
    With sa
        'dernière ligne non vide de la colonne A
        lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row
        'Plage à copier
        Set rng = .Cells(1, 6).Resize(lrsa + 1)
        Set rng2 = .Cells(1, 3).Resize(lrsa + 1)
    End With

    With co
        'dernière ligne non vide de la colonne A
        lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set cell = .Cells(lrsa, 1)
        Set Cell2 = .Cells(lrsa, 3)
    End With

    rng.Copy Destination:=cell
    rng2.Copy Destination:=Cell2

    With co
        'dernière ligne non vide de la colonne A
        lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        'plage de cellules
        Set rng = .Cells(1, 1).Resize(lrsa - 1)
        Set rng2 = .Cells(1, 3).Resize(lrsa - 1)
    End With

    'Remplissage de la colonne [B] (Numéro étude)
    Dim i1 As Integer, num1 As Variant
    Set plagebota = fb.Range("A1:A" & fb.Cells(Rows.Count, 1).End(xlUp).Row)
    With Worksheets("Correspondances")
        lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
        For i1 = 2 To lrco
            Set re = plagebota.Find(.Cells(i1, 1), lookat:=xlWhole)
            If Not re Is Nothing Then
                .Cells(i1, 2) = re.Offset(, 3)
            Else
                .Cells(i1, 2) = 0    'numéro étude
            End If
        Next
    End With

    'Conserver les valeurs recherchées (num étude)
    '                With co
    '                    For del = co.Range("B" & .Rows.Count).End(xlUp).Row To 2 Step -1
    '                        If .Range("B" & del).Value <> n Then
    '                        .Rows(del).Delete
    '                        End If
    '                    Next del
    '                End With

    'Remplissage de la colonne [E] (abondance)
    'Remplissage de la colonne [F] (remarque)
    'Remplissage de la colonne [C] (especes) (désactivé)
    Dim i2 As Integer, num2 As Variant, num3 As Variant, num4 As Variant

    Set plagesaisie = sa.Range("F1:F" & sa.Cells(Rows.Count, 6).End(xlUp).Row)

    lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
    With Worksheets("Correspondances")
        For i2 = 2 To lrco
            Set re = plagesaisie.Find(.Cells(i2, 1), lookat:=xlWhole)
            If Not re Is Nothing Then
                .Cells(i2, 5) = re.Offset(i2, -2)    'abondance
                .Cells(i2, 6) = re.Offset(i2, -1)    'remarque
            Else
                .Cells(i2, 5) = 0
                .Cells(i2, 6) = 0
            End If
        Next
    End With

    'Remplissage de la colonne [G] (cortege)
    'Remplissage de la colonne [H] (autres_infos)
    'Remplissage de la colonne [I] (x)
    'Remplissage de la colonne [J] (y)
    'Remplissage de la colonne [K] (created_date)
    'Remplissage de la colonne [L] (created_user)
    With Worksheets("Correspondances")
        For i2 = 2 To lrco
            co.Cells(i2, 11).NumberFormat = "dd/mm/yyyy;@"
            co.Cells(i2, 10).NumberFormat = "General"
            co.Cells(i2, 2).NumberFormat = "@"
            Set re = plagebota.Find(.Cells(i2, 1), lookat:=xlWhole)
            If Not re Is Nothing Then
                .Cells(i2, 7) = re.Offset(, 4) 'cortège
                .Cells(i2, 8) = re.Offset(, 5) 'autres infos
                .Cells(i2, 11) = re.Offset(, 6) 'x
                .Cells(i2, 12) = re.Offset(, 12) 'y
                .Cells(i2, 9) = re.Offset(, 15) 'created_date
                .Cells(i2, 10) = re.Offset(, 16) 'created_user
            Else
                .Cells(i2, 7) = 0
                .Cells(i2, 8) = 0
                .Cells(i2, 11) = 0
                .Cells(i2, 12) = 0
                .Cells(i2, 9) = 0
                .Cells(i2, 10) = 0
            End If
        Next
    End With
End Sub

Les parties dernièrement modifiées :

Set plagesaisie = sa.Range("F1:F" & sa.Cells(Rows.Count, 6).End(xlUp).Row)
    
.Cells(i2, 5) = re.Offset(i2, -2)    'abondance
.Cells(i2, 6) = re.Offset(i2, -1)    'remarque

Merci pour votre aide !

Je m'approche peu à peu de la fin du code !

En l'occurrence, il reste un petit soucis car les valeur rapportées par la recherche sont bonnes.. mais pas placées au bon endroit dans la plage ; il y a un décalage de 2 lignes.

Edit : C'est dû à ma modification : re.Offset(i2, -1) en indiquant i2 il fait la recherche sur 2 lignes en moins. Mais sans cela il m'affiche que des 1...

Edit 2 : du coup j'ai corrigé comme ça :

    
.Cells(i2, 5) = re.Offset(i2-2, -2)    'abondance
.Cells(i2, 6) = re.Offset(i2-2, -1)    'remarque

Bonne journée !

Le 30/06/2019 à 16:48

Re !

Finalement je ne comprend pas pourquoi il y a tant de décalages dans les résultats.

Ma solution de mettre "-2" pour compenser le décalage ne fonctionne pas dans d'autres situations.

Pour le code suivant :

    Dim i3 As Integer, re1 As Range
    Dim plagesaisie1 As Range

    Set plagesaisie1 = dc.Range("G1:G" & dc.Cells(Rows.Count, 7).End(xlUp).Row)

    lran = an.Cells(Rows.Count, 2).End(xlUp).Row
    With an
        For i3 = 2 To lran
            Set re1 = plagesaisie1.Find(.Cells(i3, 2), lookat:=xlWhole)
            If Not re1 Is Nothing Then
                    .Cells(i3, 1) = re1.Offset(i3, 25) 'Famille
                    .Cells(i3, 3) = re1.Offset(i3, -3) 'Nom Français
            Else
                    .Cells(i3, 1) = ""
                    .Cells(i3, 3) = ""
            End If
        Next
    End With

Il y a un décalage variable pour chaque résultat, je ne peux donc pas compenser. Parfois le résultat qui est récupéré provient de 8 lignes au dessus, parfois 10, parfois 2 ; parfois il est bon... Je ne comprend pas.

Est-ce que la présence de lignes vides peut poser problème ?

Le 30/06/2019 à 17:43

bonjour,

corrige ainsi

Dim i3 As Integer, re1 As Range
    Dim plagesaisie1 As Range

    Set plagesaisie1 = dc.Range("G1:G" & dc.Cells(Rows.Count, 7).End(xlUp).Row)

    lran = an.Cells(Rows.Count, 2).End(xlUp).Row
    With an
        For i3 = 2 To lran
            Set re1 = plagesaisie1.Find(.Cells(i3, 2), lookat:=xlWhole)
            If Not re1 Is Nothing Then
                    .Cells(i3, 1) = re1.Offset(, 25) 'Famille
                    .Cells(i3, 3) = re1.Offset(, -3) 'Nom Français
            Else
                    .Cells(i3, 1) = ""
                    .Cells(i3, 3) = ""
            End If
        Next
    End With
Le 30/06/2019 à 17:54

Eh bien merci encore ! Étant donné que ça me posait problème pour l'autre document, j'ai pas testé dans ce cas ci.

.Cells(i3, 1) = re1.Offset(, 25)
.Cells(i3, 1) = re1.Offset(, -3)

Tout fonctionne bien maintenant !

Merci

Bonne fin de journée.

Rechercher des sujets similaires à "vba recherche colonnes gauche"