recherchev VBA excel

Question

Bonjour, après plusieurs jours de réflexion et de recherche sur le net, j'ai fini par poser mon problème auquel j'espère avoir une ou des réponses. Sachant que je débute en VBA

Ma situation est la suivant:

Je dispose d'un fichier avec beaucoup de feuilles, dans la feuille "données", j'ai un tableau  qui commence de la cellule A2 et se termine J 11830. Dans la colonne A j'ai des référence de produit et dans la colonne G  j'ai les code d'emplacement de chaque référence.

Dans une autre feuille appelé "Emplacement" j'ai un second tableau composé de 4 colonnes "B, C, D". Dans la colonne B se trouve le code d'emplacement, et dans la colonne D se trouve les familles.

Je cherche une macro qui fait le même travail que la fonction recherchev dans Excel.
C'est à dire je veux chercher le code d'emplacement de la feuille "données"  dans la feuille "emplacement" et de renvoyé la famille qui lui correspond (de la colonne D feuille "emplacement "a la colonne J de la feuille "données" ).

Exemple de recherchev sous Excel pour la 1iere référence dans la feuille données : 

=recherchev(G2;Emplacement!$B$2:$D$8000;3;0)


J'espère que j'été assez claire, je sais que pour certain c facile mais pas pour moi vu que je débute sur le VBA.

Merci d'avance

Bidouilleu_R · Answer

je l'ai fait avec un copié collé mais on peut le faire 
autrement avec une variable.
c'est au choix.
A+


Sub Assemble_Famille()  'regroupe les infos de la feuille2
    Dim N_Lig As Long       ' contient le nombre de ligne
    Dim MLig As Long        ' contient le nombre de ligne
    Dim C As Variant        ' L'objet cellule
    Dim ChaineR As String   ' la chaine de recherche



    Sheets("données").Select
    Nlig = Range("G2").CurrentRegion.Rows.Count 'nombre de ligne
    Sheets("emplacement").Select
    MLig = Range("b2").CurrentRegion.Rows.Count 'nombre de ligne
    
    Sheets("données").Select
    For Each C In Range("G2:G" & Nlig) ' pour chaque cellule "G" de G2 à Gnn
        ChaineR = C.Value              ' je recherche cette valeur
        Sheets("emplacement").Select
'        Columns("A:A").Select
'
        With Worksheets("Emplacement").Range("B2:B" & MLig + 1) ' Avec la feuille dans la plage A2..Ann
          Set D = .Find(ChaineR, LookIn:=xlValues) ' trouve le code
                D.Offset(0, 2).Select 'à partir de la cellule trouvée copie 7 cols à droite
                Selection.Copy
                Sheets("données").Select     ' colle les infos correspondantes à 12 cols à droite
                C.Offset(0, 3).Select
                ActiveSheet.Paste

        End With  ' fin du traitement
        
     Next ' fin de la boucle
End Sub

Bidouilleu_R · Answer

j'ai modifié le code sur 2 points.

1) j'ai supprimé le copié/coller - j'aime pas ( je préfère utiliser une variable car plus lisible, on peut aussi utiliser directement l'objet "D"

2) le contrôle de la recherche.
Il y a erreur '91' si l'objet ne trouve rien ( D prend l'état Nothing)
Donc si tu recherches quelque chose qui n'existe pas ( le code d'emplacement est erroné ou n'existe pas alors la famille ne sera pas renseignée )
Il n'y aura pas de message d'erreur mais la case sera vide en colonne J
Désolé pour l'erreur.
A+


Sub Assemble_Famille()  'regroupe les infos de la feuille2
    Dim N_Lig As Long       ' contient le nombre de ligne
    Dim MLig As Long        ' contient le nombre de ligne
    Dim C As Variant        ' L'objet cellule
    Dim ChaineR As String   ' la chaine de recherche
    Dim ChaineT As Variant   ' la chaine trouvée


    Sheets("données").Select
    Nlig = Range("G2").CurrentRegion.Rows.Count 'nombre de ligne
    Sheets("emplacement").Select
    MLig = Range("b2").CurrentRegion.Rows.Count 'nombre de ligne
    
    Sheets("données").Select
    For Each C In Range("G2:G" & Nlig) ' pour chaque cellule "G" de G2 à Gnn
        ChaineR = C.Value              ' je recherche cette valeur
        Sheets("emplacement").Select
'        Columns("A:A").Select
'
        With Worksheets("Emplacement").Range("B2:B" & MLig + 1) ' Avec la feuille dans la plage A2..Ann
          Set D = .Find(ChaineR, LookIn:=xlValues) ' trouve le code
                If Not D Is Nothing Then
                    ChaineT = D.Offset(0, 2).Value 'on met dans chaineT la valeur Trouvée
                    Sheets("données").Select     ' sélectionne la feuille données
                    C.Offset(0, 3).Value = ChaineT
                End If
        End With  ' fin du traitement
        
     Next ' fin de la boucle
End Sub

Bidouilleu_R · Answer

je regarde ça cette après midi...
'1004' veut dire que l'objet n'est pas accessible ou qu'on lui donne quelque chose qu'il ne veut pas manger...

Bidouilleu_R · Answer

2 petits points :
1) j'ai modifié la ligne 
            X = Cells(doub1, 4).Value + Cells(doub2, 4).Value
            Cells(doub1, 4).Value = X
je comprends ce que tu fais mais sans les données ce n'est pas facile.

En utilisant une variable X on sépare les opérations
d'abord le calcul puis l'affectation.
2) j'ai eu une erreur à la ligne 

Range(Cells(doub2, 1).Value, Cells(doub2, 10)).ClearContents
cela peut venir de mes données que j'avais mis au PIF
sinon il faut corriger.

Astuce!

pour rendre le code que tu copies / colles
click sur le bouton code   <>
A+ 

R

Sub essai()

Dim X As Variant

'********************************Suppression doublons 20-80RM
doub1 = 6
doub2 = 7

Sheets("20-80 RM").Select

Do
    Do
        If (Cells(doub1, 2).Value = Cells(doub2, 2).Value) Then
            If Cells(doub1, 7).Value < Cells(doub2, 7).Value Then
                Cells(doub1, 7).Value = Cells(doub2, 7).Value
            Else
                Cells(doub1, 7).Value = Cells(doub1, 7).Value
            End If
            X = Cells(doub1, 4).Value + Cells(doub2, 4).Value
            Cells(doub1, 4).Value = X
            Range(Cells(doub2, 1).Value, Cells(doub2, 10)).ClearContents
            'le programe block a ce niveau de la macro
        Else
            doub2 = doub2 + 1
        End If
    Loop Until (Cells(doub2, 2).Value = "")
    doub1 = doub1 + 1
    doub2 = doub1 + 1
Loop Until (Cells(doub1, 2).Value = "")
End Sub

Bidouilleu_R · Answer

dans cette partie ...    

   With Worksheets("Emplacement").Range("B2:B" & MLig + 1) ' Avec la feuille dans la plage A2..Ann
          Set D = .Find(ChaineR, LookIn:=xlValues) ' trouve le code
                D.Offset(0, 2).Select 'à partir de la cellule trouvée copie 7 cols à droite
                Selection.Copy
                Sheets("données").Select     ' colle les infos correspondantes à 12 cols à droite
                C.Offset(0, 3).Select
                ActiveSheet.Paste

        End With  ' fin du traitement


.....
Uitise une variable pour stcker 
nouvelleVariable = D.Offset(0, 2).value
puis regarde ce qu'il y a dedans
puis avec
C.Offset(0, 3).value = nouvellevariable pour suivre ce qui se passe.

Recherchev VBA excel

5 réponses

Newsletters