Recherchev VBA excel

Fermé

lesafio - 22 avril 2010 à 15:41
lesafio - 28 avril 2010 à 09:46

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

A voir également:

Recherchev VBA excel
Liste déroulante excel - Guide
Formule excel - Guide
Si et excel - Guide
Aller à la ligne excel - Guide
Mise en forme conditionnelle excel - Guide

5 réponses

Réponse 1 / 5

Bidouilleu_R Messages postés 1181 Date d'inscription mardi 27 mai 2008 Statut Membre Dernière intervention 12 juillet 2012 288
23 avril 2010 à 09:08

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

lesafio
23 avril 2010 à 10:00

Sa marche nickel, je vous remercie beaucoup pour l'aide et de m'avoir accordé votre temps.

lesafio
23 avril 2010 à 10:49

Re bonjour Bidouilleu_R, j'ai un autre service à vous demander s'il vous plait.

J'ai un bout de ma macro qui est le suivant :

'********************************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
Cells(doub1, 4).Value = Cells(doub1, 4).Value + Cells(doub2, 4).Value
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 = "")

Sur ce bout la, je souhaite supprimé les doublons dans la feuille « 20-80 RM » on faisant :
1) la somme de toutes les cellules de la colonne 4 qui correspond à la quantité de la même référence.
2) Dans les cellules de la colonne 7 ne garder que la valeur la plus grande bien sur toujours de la même référence.

Mon traitement commence de la ligne N° 6 jusqu'à la fin du tableau.

Quand je lance la macro, sa me met un code erreur `1004 ' , La méthode `range' de l'obgé `_globale' a echoué. Et sa block a ce niveau de la macro :

Range(Cells(doub2, 1).Value, Cells(doub2, 10)).ClearContents

Puis je savoir comment faire pour régler ce problème merci d'avance

Réponse 2 / 5

Bidouilleu_R Messages postés 1181 Date d'inscription mardi 27 mai 2008 Statut Membre Dernière intervention 12 juillet 2012 288
22 avril 2010 à 16:16

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

lesafio
22 avril 2010 à 21:42

Merci pour la réponse si rapide, j'ai copié coller la macro, sa tourne bien au début mais après sa me met une erreur d'exécution "91" je fait débogage et c bloqué au niveau de la ligne :

D.offset(0,2).Select 'à partir de la cellule trouvée copie

Réponse 3 / 5

Bidouilleu_R Messages postés 1181 Date d'inscription mardi 27 mai 2008 Statut Membre Dernière intervention 12 juillet 2012 288
23 avril 2010 à 13:31

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...

Réponse 4 / 5

Bidouilleu_R Messages postés 1181 Date d'inscription mardi 27 mai 2008 Statut Membre Dernière intervention 12 juillet 2012 288
23 avril 2010 à 13:48

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

lesafio
25 avril 2010 à 19:32

Merci pour la réponse , j'ai trouvé d'où vient l'erreur . il fallait supprimé le .value dans la ligne : Range(Cells(doub2, 1).Value, Cells(doub2, 10)).ClearContents .

Par contre pour le programme que vous m'avez donné pour la recherchev, j'ai un petit souci avec.

un petite rappel:

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 "A, 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)

le programme que vous m'avez filé tourne bien nickel, sauf pour une référence, qui se trouve dans la 1iere ligne du tableau de la feuille "emplacement". le code emplacement de cette référence est 60, la famille est Consignataire, alors que après l'exécution il me renvoie autre famille que Consignataire. Sachant que cette référence et la 1iere dans le tableau (la ligne 2 du fichier excel).

Pensez vous savoir d'où peut venir le probleme?

Merci d'avance

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 5

Bidouilleu_R Messages postés 1181 Date d'inscription mardi 27 mai 2008 Statut Membre Dernière intervention 12 juillet 2012 288
26 avril 2010 à 16:17

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.

lesafio
27 avril 2010 à 16:33

Bonjour, est désolé pour le retard.

J'ai pu suivre ce qui se passe avec votre programme.

Au fait dés qu'il trouve la valeur cherché dans la feuille " emplacement" il renvoie la valeur voulu, par contre pour la référence qui suit, le programme ne recherche pas dans tout le tableau de la feuille "emplacement" il continue de la dernière valeur trouver alors qu'il doit reparcourir tout le tableau. C'est comme si à chaque fois qu'il va chercher une référence, il ne réinitialise pas.

Comment puis-je faire svp ?

Je me suis permis de faire ce bout de programme a la place mais sa marche, mais sa prend beaucoup de temps vu le nombre de ligne que j'ai a géré.

Sheets("données").Select
i = 2
j = 2

Do
    If Cells(i, 7).Value = Sheets("Emplacement").Cells(j, 2).Value Then
        Cells(i, 10).Value = Sheets("Emplacement").Cells(j, 4).Value
        i = i + 1
        j = 2
        
    Else
      
    j = j + 1
    
    End If

Loop Until (Cells(i, 2).Value = "")

lesafio
28 avril 2010 à 09:46

bonjour, j'ai effectuer le test avec mon bout de macro et sa marche par contre pour le nombre que j'ai de ligne sa prend 30min et sa fait beaucoup. Avez vous une idée de se que je peut faire pour que sa soit plus fluide? merci

Discussions similaires

Combiné SI et RECHERCHEV excel

Discussions similaires

Newsletters