[code]correction code pour afficher les doublons lors d'une recherche

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion PEX
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
P

PEX

XLDnaute Occasionnel
bonjour,

Bonjour a tous,


étant novice, et devant faire une macro assez lourde,😉je me permets de soliciter votre aide car je n'arrive pas a coder en VBA ma recherche je montre mon code :
Code: 
Private Sub quit_Click()

Unload Me

End Sub

Private Sub Save_Click()

    Dim Resultat, R As Range
    Dim ligne, occurence As Long
    
    If TBNumLot <> "" Then 
    
        Set Resultat = ThisWorkbook.Sheets("prépreg").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        
        If Not Resultat Is Nothing Then
                        MsgBox ("Recherche effectuée")
            
            occurence = 0
            ligne = 2
            With ThisWorkbook
                For Each R In .Sheets("prépreg").Range("C1:C" & .Sheets("prépreg").Range("C:C").End(xlDown).Row)
                    If R.Value = TBNumLot.Value Then
                        If occurence = 0 Then
                            .Sheets("recherche").Range("B" & ligne).Value = .Sheets("prépreg").Range("B" & R.Row).Value
                            .Sheets("recherche").Range("C" & ligne).Value = .Sheets("prépreg").Range("A" & R.Row).Value
                            .Sheets("recherche").Range("D" & ligne).Value = .Sheets("prépreg").Range("I" & R.Row).Value
                            .Sheets("recherche").Range("E" & ligne).Value = .Sheets("prépreg").Range("J" & R.Row).Value
                            .Sheets("recherche").Range("F" & ligne).Value = .Sheets("prépreg").Range("O" & R.Row).Value
                            .Sheets("recherche").Range("G" & ligne).Value = .Sheets("prépreg").Range("M" & R.Row).Value
                            .Sheets("recherche").Range("H" & ligne).Value = .Sheets("prépreg").Range("D" & R.Row).Value
                            .Sheets("recherche").Range("I" & ligne).Value = .Sheets("prépreg").Range("C" & R.Row).Value
                            .Sheets("recherche").Range("J" & ligne).Value = .Sheets("prépreg").Range("S" & R.Row).Value
                        End If
                        .Sheets("recherche").Range("K" & ligne).Value = .Sheets("prépreg").Range("V" & R.Row).Value
                        .Sheets("recherche").Range("L" & ligne).Value = .Sheets("prépreg").Range("W" & R.Row).Value
                        occurence = occurence + 1
                        ligne = ligne + 1
                    End If
                Next
            End With
        Else
                MsgBox ("Aucune information trouvée")
        End If
        
        Unload recherchelot
        
    Sheets("recherche").Select
    
    End If
    
End Sub

Private Sub UserForm_Click()

End Sub

alors voila mon souci est que parfois la valeur rechercher revient plusieur fois dans ma base de données, j'aimerai savoir s'il serait possible d'afficher tous les doublons.

mais aussi savoir comme base de recherche c'est a dire :
Code: 
Set Resultat = ThisWorkbook.Sheets("prépreg").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
on pouvait mettre une seconde colone de recherche ( et si possible une colone situé dans une aute feuille ) en plus de celle déja marqué dans le code !

merci

cordialement

celine
 
Trier par date Trier par votes
Re :
Code: 
correction code pour afficher les doublons lors d'une recherche[/b]

je tiens a preciser que lorsque je fais une recherche avec seulement des chiffre ou nombre ma recherche est faite mais ne m'affiche aucun resultat en revanche quand je rajoute une lettre a mon code de chiffre il me montre la ligne complete !! 

je ne comprends pas pourquoi
 
Vote positif 0 Vote négatif
Re :
Code: 
correction code pour afficher les doublons lors d'une recherche[/b]

[COLOR=#000080]Bonjour Céline, bonjour le forum,

Pour ta première question. Comment voudrais-tu afficher les doublons ? Dans un message, ou bien, par exemple, en les mettant en évidence par un couleur sur la cellule ou sur la ligne entière ? Et ensuite que faire après avoir mis les doublons en évidence ? Continuer le code ?

Pour ta deuxième question, il te faudra définir une nouvelle plage comme l'exemple ci-dessous. Mais encore une fois, comment intégrer cela dans ton code actuel ?
[/COLOR][CODE]Sub Macro1()
Dim r1 As Range 'déclare la variable r1 (Recerche 1)
Dim r2 As Range 'déclare la variable r2 (Recerche 2)
Dim trouvé As Boolean 'déclare la variable trouvé
Dim nom(1) As String 'déclare le tableau de deux variables nom (nom du ou des onglets contenant au moins une occurence)

    Set r1 = ThisWorkbook.Sheets("prépreg").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext) 'définit la recherche 1
    Set r2 = ThisWorkbook.Sheets("onglet2").Range("A:A").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext) 'définit la recherche 2
    If Not r1 Is Nothing Then 'condition : si il existe au moins un occurrence dans la colonne C de l 'onglet "prépreg"
        trouvé = True 'definit la variable trouvé
        nom(0) = "prépreg" 'récupère le nom de l'onglet
    End If 'fin de la condition
    If Not r2 Is Nothing Then 'condition : si il existe au moins un occurrence dans la colonne A de l 'onglet "onglet2" (à adapter à ton cas)
        trouvé = True 'definit la variable trouvé
        nom(1) = "onglet2"
    End If 'récupère le nom de l'onglet
    
    If trouvé = True Then 'condition si au moins une occurrence
        
        For x = 0 To UBound(nom) 'boucle sur un ou deux onglets
            With Sheets(nom(x)) 'prend en compte l'onglet en cours
            
                '..... le reste de ton code
            
            End With 'fin de la pros en compte de l'onglet
        Next x 'prochain onglet de la boucle
        
    Else 'sinon
        MsgBox ("Aucune information trouvée")
    End If 'fin de la condition
End Sub

Sinon un petit bout de fichier en exemple serait le bienvenu...
 
Vote positif 0 Vote négatif
Re :
Code: 
correction code pour afficher les doublons lors d'une recherche[/b]

[quote="Robert, post: 1150690"][COLOR=#000080]Bonjour Céline, bonjour le forum,

Pour ta première question. Comment voudrais-tu afficher les doublons ? Dans un message, ou bien, par exemple, en les mettant en évidence par un couleur sur la cellule ou sur la ligne entière ? Et ensuite que faire après avoir mis les doublons en évidence ? Continuer le code ?

Pour ta deuxième question, il te faudra définir une nouvelle plage comme l'exemple ci-dessous. Mais encore une fois, comment intégrer cela dans ton code actuel ?
[/COLOR][CODE]Sub Macro1()
Dim r1 As Range 'déclare la variable r1 (Recerche 1)
Dim r2 As Range 'déclare la variable r2 (Recerche 2)
Dim trouvé As Boolean 'déclare la variable trouvé
Dim nom(1) As String 'déclare le tableau de deux variables nom (nom du ou des onglets contenant au moins une occurence)

    Set r1 = ThisWorkbook.Sheets("prépreg").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext) 'définit la recherche 1
    Set r2 = ThisWorkbook.Sheets("onglet2").Range("A:A").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext) 'définit la recherche 2
    If Not r1 Is Nothing Then 'condition : si il existe au moins un occurrence dans la colonne C de l 'onglet "prépreg"
        trouvé = True 'definit la variable trouvé
        nom(0) = "prépreg" 'récupère le nom de l'onglet
    End If 'fin de la condition
    If Not r2 Is Nothing Then 'condition : si il existe au moins un occurrence dans la colonne A de l 'onglet "onglet2" (à adapter à ton cas)
        trouvé = True 'definit la variable trouvé
        nom(1) = "onglet2"
    End If 'récupère le nom de l'onglet
    
    If trouvé = True Then 'condition si au moins une occurrence
        
        For x = 0 To UBound(nom) 'boucle sur un ou deux onglets
            With Sheets(nom(x)) 'prend en compte l'onglet en cours
            
                '..... le reste de ton code
            
            End With 'fin de la pros en compte de l'onglet
        Next x 'prochain onglet de la boucle
        
    Else 'sinon
        MsgBox ("Aucune information trouvée")
    End If 'fin de la condition
End Sub

Sinon un petit bout de fichier en exemple serait le bienvenu...[/QUOTE]

je te joints mon fichier par contre si possible a la fin de ce topic sera til possible de le supprimer ( ou les fichiers joints) tu comprendra en l'ouvrant 🙂 ..

tu verra dans le fichier joint 2 userform ( recherchelot et rechercheview )
recherlot est une recherche que je souhaite effectuer en cherchant ma valeur dans toutes les feuilles du classeur au colone qui ont le nom de "numero de lot client" "numero de lot entreprise" "ref/code article" pour m'afficher les resultats dans un tableau (feuille recherche)

pour rechercheview je souhaite on fonction du choix que sa me renseigne les infos dans un tableau ( feuille recherche)

les doublons ne doivent pas étre masquer, car parfois les lots ne sont pas les memes. je souhaite simplement a me faire afficher les infos qui sont dans mon classeur excel portant le nom de mon produit voulu

je sais pas si c'est tres claire mais sa va faire une semaine que je bosse dessus sans relache et je n'en vois pas la fin ..

PS: ceux qui m'aideront sur se projet, verrons leurs surnoms poster dans un rapport d'activité 🙂

j'ai un souci car mon fichier fait 3Mo ... faut que je trouve poru te l'envoyer

cordialement

celine
 
Vote positif 0 Vote négatif
Re :
Code: 
correction code pour afficher les doublons lors d'une recherche[/b]

[CODE]Private Sub save_Click()
Dim r1 As Range 'déclare la variable r1 (Recerche 1)
Dim r2 As Range 'déclare la variable r2 (Recerche 2)
Dim r3 As Range
Dim r4 As Range
Dim r5 As Range
Dim r6 As Range
Dim r7 As Range

Dim trouvé As Boolean 'déclare la variable trouvé
Dim nom(1) As String 'déclare le tableau de deux variables nom (nom du ou des onglets contenant au moins une occurence)

    Set r1 = ThisWorkbook.Sheets("prépreg").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext) 'définit la recherche 1
    Set r2 = ThisWorkbook.Sheets("prépreg").Range("D:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext) 'définit la recherche 2
    Set r3 = ThisWorkbook.Sheets("tissus sec").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)  'définit la recherche 3
    Set r4 = ThisWorkbook.Sheets("consommable composite").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    Set r5 = ThisWorkbook.Sheets("consommable composite").Range("D:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    Set r6 = ThisWorkbook.Sheets("résine").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    Set r7 = ThisWorkbook.Sheets("résine").Range("D:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
          
    If Not r1 Is Nothing Then 'condition : si il existe au moins un occurrence dans la colonne C de l 'onglet "prépreg"
        trouvé = True 'definit la variable trouvé
        nom(0) = "prépreg" 'récupère le nom de l'onglet
    End If 'fin de la condition
    If Not r2 Is Nothing Then 'condition : si il existe au moins un occurrence dans la colonne A de l 'onglet "onglet2" (à adapter à ton cas)
        trouvé = True 'definit la variable trouvé
        nom(1) = "prépreg"
    End If 'récupère le nom de l'onglet
    If Not r3 Is Nothing Then
        trouvé = True
        nom(2) = "tissus sec"
    End If
    If Not r4 Is Nothing Then
        trouvé = True
        nom(3) = "consommable composite"
    End If
    If Not r5 Is Nothing Then
        trouvé = True
        nom(4) = "consommable composite"
    End If
    If Not r6 Is Nothing Then
        trouvé = True
        nom(5) = "résine"
    End If
    If Not r7 Is Nothing Then
        trouvé = True
        nom(6) = "résine"
    
    If trouvé = True Then 'condition si au moins une occurrence
        
        For x = 0 To UBound(nom) 'boucle sur un ou deux onglets
            With Sheets(nom(x)) 'prend en compte l'onglet en cours
            
    Dim Resultat, R As Range
    Dim ligne, occurence As Long

Set Resultat = ThisWorkook.Sheets("sécurité").Range("B:B").Find(What:=CBsecurite.Value, lookln:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
   
    If Not Resultat Is Nothing Then
    MsgBox ("Recherche terminé")

occurence = 0
ligne = 2
With ThisWorkbook
    For Each R In .Sheets("sécurité").Range("B1:B" & .Sheets("sécurité").Range("B:B").End(xlDown).Row)
        If R.Value = CBsecurite.Value Then
            If occurence = 0 Then
            .Sheets("recherche").Range("B" & ligne).Value = .Sheets("sécurité").Range("B" & R.Row).Value
            .Sheets("recherche").Range("C" & ligne).Value = .Sheets("sécurité").Range("A" & R.Row).Value
            .Sheets("recherche").Range("D" & ligne).Value = .Sheets("sécurité").Range("C" & R.Row).Value
            .Sheets("recherche").Range("E" & ligne).Value = .Sheets("sécurité").Range("E" & R.Row).Value
            .Sheets("recherche").Range("F" & ligne).Value = .Sheets("sécurité").Range("H" & R.Row).Value
            .Sheets("recherche").Range("G" & ligne).Value = .Sheets("sécurité").Range("A" & R.Row).Value
            End If
        End If
       Next
     
            
            End With 'fin de la pros en compte de l'onglet
        Next x 'prochain onglet de la boucle
        
    Else 'sinon
        MsgBox ("Aucune information trouvée")
    End If 'fin de la condition
End Sub

le code ne fonctionne pas 🙁 🙁
 
Vote positif 0 Vote négatif
Re :
Code: 
correction code pour afficher les doublons lors d'une recherche[/b]

[quote="PEX, post: 1151078"][CODE]Private Sub save_Click()
Dim r1 As Range 'déclare la variable r1 (Recerche 1)
Dim r2 As Range 'déclare la variable r2 (Recerche 2)
Dim r3 As Range
Dim r4 As Range
Dim r5 As Range
Dim r6 As Range
Dim r7 As Range

Dim trouvé As Boolean 'déclare la variable trouvé
Dim nom(1) As String 'déclare le tableau de deux variables nom (nom du ou des onglets contenant au moins une occurence)

    Set r1 = ThisWorkbook.Sheets("prépreg").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext) 'définit la recherche 1
    Set r2 = ThisWorkbook.Sheets("prépreg").Range("D:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext) 'définit la recherche 2
    Set r3 = ThisWorkbook.Sheets("tissus sec").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)  'définit la recherche 3
    Set r4 = ThisWorkbook.Sheets("consommable composite").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    Set r5 = ThisWorkbook.Sheets("consommable composite").Range("D:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    Set r6 = ThisWorkbook.Sheets("résine").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    Set r7 = ThisWorkbook.Sheets("résine").Range("D:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
          
    If Not r1 Is Nothing Then 'condition : si il existe au moins un occurrence dans la colonne C de l 'onglet "prépreg"
        trouvé = True 'definit la variable trouvé
        nom(0) = "prépreg" 'récupère le nom de l'onglet
    End If 'fin de la condition
    If Not r2 Is Nothing Then 'condition : si il existe au moins un occurrence dans la colonne A de l 'onglet "onglet2" (à adapter à ton cas)
        trouvé = True 'definit la variable trouvé
        nom(1) = "prépreg"
    End If 'récupère le nom de l'onglet
    If Not r3 Is Nothing Then
        trouvé = True
        nom(2) = "tissus sec"
    End If
    If Not r4 Is Nothing Then
        trouvé = True
        nom(3) = "consommable composite"
    End If
    If Not r5 Is Nothing Then
        trouvé = True
        nom(4) = "consommable composite"
    End If
    If Not r6 Is Nothing Then
        trouvé = True
        nom(5) = "résine"
    End If
    If Not r7 Is Nothing Then
        trouvé = True
        nom(6) = "résine"
    
    If trouvé = True Then 'condition si au moins une occurrence
        
        For x = 0 To UBound(nom) 'boucle sur un ou deux onglets
            With Sheets(nom(x)) 'prend en compte l'onglet en cours
            
    Dim Resultat, R As Range
    Dim ligne, occurence As Long

Set Resultat = ThisWorkook.Sheets("sécurité").Range("B:B").Find(What:=CBsecurite.Value, lookln:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
   
    If Not Resultat Is Nothing Then
    MsgBox ("Recherche terminé")

occurence = 0
ligne = 2
With ThisWorkbook
    For Each R In .Sheets("sécurité").Range("B1:B" & .Sheets("sécurité").Range("B:B").End(xlDown).Row)
        If R.Value = CBsecurite.Value Then
            If occurence = 0 Then
            .Sheets("recherche").Range("B" & ligne).Value = .Sheets("sécurité").Range("B" & R.Row).Value
            .Sheets("recherche").Range("C" & ligne).Value = .Sheets("sécurité").Range("A" & R.Row).Value
            .Sheets("recherche").Range("D" & ligne).Value = .Sheets("sécurité").Range("C" & R.Row).Value
            .Sheets("recherche").Range("E" & ligne).Value = .Sheets("sécurité").Range("E" & R.Row).Value
            .Sheets("recherche").Range("F" & ligne).Value = .Sheets("sécurité").Range("H" & R.Row).Value
            .Sheets("recherche").Range("G" & ligne).Value = .Sheets("sécurité").Range("A" & R.Row).Value
            End If
        End If
       Next
     
            
            End With 'fin de la pros en compte de l'onglet
        Next x 'prochain onglet de la boucle
        
    Else 'sinon
        MsgBox ("Aucune information trouvée")
    End If 'fin de la condition
End Sub

le code ne fonctionne pas 🙁 🙁[/QUOTE]

bon bas maitnenant j'ai des erreur d'execution 9

je veux pleurer

je vous met le code a l'heure actuel

Code: 
Private Sub quit_Click()

Unload Me

End Sub

Sub save_Click()
Dim r1 As Range 'déclare la variable r1 (Recerche 1)
Dim r2 As Range 'déclare la variable r2 (Recerche 2)
Dim r3 As Range
Dim r4 As Range
Dim r5 As Range
Dim r6 As Range
Dim r7 As Range

Dim trouvé As Boolean 'déclare la variable trouvé
Dim nom(1) As String 'déclare le tableau de deux variables nom (nom du ou des onglets contenant au moins une occurence)

    Set r1 = ThisWorkbook.Sheets("prépreg").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext) 'définit la recherche 1
    Set r2 = ThisWorkbook.Sheets("prépreg").Range("D:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext) 'définit la recherche 2
    Set r3 = ThisWorkbook.Sheets("tissus sec").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)  'définit la recherche 3
    Set r4 = ThisWorkbook.Sheets("consommable composite").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    Set r5 = ThisWorkbook.Sheets("consommable composite").Range("D:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    Set r6 = ThisWorkbook.Sheets("résine").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    Set r7 = ThisWorkbook.Sheets("résine").Range("D:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
          
    If Not r1 Is Nothing Then 'condition : si il existe au moins un occurrence dans la colonne C de l 'onglet "prépreg"
        trouvé = True 'definit la variable trouvé
        nom(0) = "prépreg" 'récupère le nom de l'onglet
    End If 'fin de la condition
    If Not r2 Is Nothing Then 'condition : si il existe au moins un occurrence dans la colonne A de l 'onglet "onglet2" (à adapter à ton cas)
        trouvé = True 'definit la variable trouvé
        nom(1) = "prépreg"
    End If 'récupère le nom de l'onglet
    If Not r3 Is Nothing Then
        trouvé = True
        nom(2) = "tissus sec"
    End If
    If Not r4 Is Nothing Then
        trouvé = True
        nom(3) = "consommable composite"
    End If
    If Not r5 Is Nothing Then
        trouvé = True
        nom(4) = "consommable composite"
    End If
    If Not r6 Is Nothing Then
        trouvé = True
        nom(5) = "résine"
    End If
    If Not r7 Is Nothing Then
        trouvé = True
        nom(6) = "résine"
    
    If trouvé = True Then 'condition si au moins une occurrence
        
        For x = 0 To UBound(nom) 'boucle sur un ou deux onglets
            With Sheets(nom(x)) 'prend en compte l'onglet en cours
            
             If occurence = 0 Then
                        .Sheets("recherche").Range("B" & ligne).Value = .Sheets("prépreg").Range("B" & R.Row).Value
                        .Sheets("recherche").Range("C" & ligne).Value = .Sheets("prépreg").Range("A" & R.Row).Value
                        .Sheets("recherche").Range("D" & ligne).Value = .Sheets("prépreg").Range("I" & R.Row).Value
                        .Sheets("recherche").Range("E" & ligne).Value = .Sheets("prépreg").Range("J" & R.Row).Value
                        .Sheets("recherche").Range("F" & ligne).Value = .Sheets("prépreg").Range("O" & R.Row).Value
                        .Sheets("recherche").Range("G" & ligne).Value = .Sheets("prépreg").Range("M" & R.Row).Value
                        .Sheets("recherche").Range("H" & ligne).Value = .Sheets("prépreg").Range("D" & R.Row).Value
                        .Sheets("recherche").Range("I" & ligne).Value = .Sheets("prépreg").Range("C" & R.Row).Value
                        .Sheets("recherche").Range("J" & ligne).Value = .Sheets("prépreg").Range("S" & R.Row).Value
    
                        End If
                        .Sheets("recherche").Range("K" & ligne).Value = .Sheets("prépreg").Range("V" & R.Row).Value
                        .Sheets("recherche").Range("L" & ligne).Value = .Sheets("prépreg").Range("W" & R.Row).Value
                        occurence = occurence + 1
                        ligne = ligne + 1
                End With
                Next x
              Else
                
     'sinon
        MsgBox ("Aucune information trouvée")
     End If
     
     'fin de la condition
End If
Unload Me
End Sub

Private Sub UserForm_Click()

End Sub
 
Vote positif 0 Vote négatif
Re :
Code: 
correction code pour afficher les doublons lors d'une recherche[/b]

[COLOR=#000080]Bonjour Cécile, bonjour le forum,

Je n'ai pas pu télécharger ton fichier... 
Tu nous dis : [I]j'ai des erreur d'exécutuion 9[/I] mais il faut que tu nous indiques quelle(s) ligne(s) pose(nt) problème.
Je jette un coup d'œil sur ton dernier code...[/COLOR]
 
Vote positif 0 Vote négatif
Re :
Code: 
correction code pour afficher les doublons lors d'une recherche[/b]

Bonjour PEX, Robert :-), PAs tout suivi mais on trouve dans le dernier code:[code=vb]Dim nom(1) As String
et ensuite
VB: 
nom(6) = "résine"
Ca ne dois pas aller... si le tableaunom est de 0 à 1 (deux éléments), on ne peux pas atribuer une valeur à nom(6). Cordialement
 
Vote positif 0 Vote négatif
Re :
Code: 
correction code pour afficher les doublons lors d'une recherche[/b]

[COLOR=#000080]Bonjour Célile, Efgé, bonjour le forum,

Oui, il y avait plusieurs incohérences dans le dernier code, des variables non déclarées (moins grave) mais surtout pas initialisées...
Il est clair que toi seule sait exactement ce que tu veux mais en analysant ton code je me demande si ce n'est pas vers cette voie qu'il faudrait s'orienter ?
Mon seul soucis, dans cette nouvelle proposition, serait la réinitialisation ou pas de la variable [B]occurrence[/B]. Dans l'exemple ci-dessous elle ne l'est pas :
[/COLOR][CODE]Sub save_Click()
Dim r1 As Range 'déclare la variable r1 (Recerche 1)
Dim r2 As Range 'déclare la variable r2 (Recerche 2)
Dim r3 As Range 'déclare la variable r2 (Recerche 3)
Dim r4 As Range 'déclare la variable r2 (Recerche 4)
Dim trouvé As Boolean 'déclare la variable trouvé
Dim ligne As Integer 'déclare la variable ligne
Dim occurrence As Integer 'déclare la variable occurrence


If TBNumLot <> "" Then
    Set r1 = ThisWorkbook.Sheets("prépreg").Range("C:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext) 'définit la recherche 1
    If Not r1 Is Nothing Then 'condition : si il existe au moins un occurrence dans la colonne C de l 'onglet "prépreg"
        trouvé = True 'definit la variable trouvé
        MsgBox "Recherche effectuée dans l'onglet prépeg"
        occurence = 0
        ligne = 2
        If occurence = 0 Then
            .Sheets("recherche").Range("B" & ligne).Value = .Sheets("prépreg").Range("B" & r1.Row).Value
            .Sheets("recherche").Range("C" & ligne).Value = .Sheets("prépreg").Range("A" & r1.Row).Value
            .Sheets("recherche").Range("D" & ligne).Value = .Sheets("prépreg").Range("I" & r1.Row).Value
            .Sheets("recherche").Range("E" & ligne).Value = .Sheets("prépreg").Range("J" & r1.Row).Value
            .Sheets("recherche").Range("F" & ligne).Value = .Sheets("prépreg").Range("O" & r1.Row).Value
            .Sheets("recherche").Range("G" & ligne).Value = .Sheets("prépreg").Range("M" & r1.Row).Value
            .Sheets("recherche").Range("H" & ligne).Value = .Sheets("prépreg").Range("D" & r1.Row).Value
            .Sheets("recherche").Range("I" & ligne).Value = .Sheets("prépreg").Range("C" & r1.Row).Value
            .Sheets("recherche").Range("J" & ligne).Value = .Sheets("prépreg").Range("S" & r1.Row).Value
        End If
        .Sheets("recherche").Range("K" & ligne).Value = .Sheets("prépreg").Range("V" & r1.Row).Value
        .Sheets("recherche").Range("L" & ligne).Value = .Sheets("prépreg").Range("W" & r1.Row).Value
        occurence = occurence + 1
        ligne = ligne + 1
    End If 'fin de la condition
    
    Set r2 = ThisWorkbook.Sheets("tissus sec").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)  'définit la recherche 3
    If Not r2 Is Nothing Then 'condition : si il existe au moins un occurrence dans la colonne A de l 'onglet "onglet2" (à adapter à ton cas)
        trouvé = True 'definit la variable trouvé
        MsgBox "Recherche effectuée dans l'onglet tissu sec"
        'occurence = 0
        'ligne = 2
        If occurence = 0 Then
            .Sheets("recherche").Range("B" & ligne).Value = .Sheets("tissus sec").Range("B" & r2.Row).Value
            .Sheets("recherche").Range("C" & ligne).Value = .Sheets("tissus sec").Range("A" & r2.Row).Value
            .Sheets("recherche").Range("D" & ligne).Value = .Sheets("tissus sec").Range("I" & r2.Row).Value
            .Sheets("recherche").Range("E" & ligne).Value = .Sheets("tissus sec").Range("J" & r2.Row).Value
            .Sheets("recherche").Range("F" & ligne).Value = .Sheets("tissus sec").Range("O" & r2.Row).Value
            .Sheets("recherche").Range("G" & ligne).Value = .Sheets("tissus sec").Range("M" & r2.Row).Value
            .Sheets("recherche").Range("H" & ligne).Value = .Sheets("tissus sec").Range("D" & r2.Row).Value
            .Sheets("recherche").Range("I" & ligne).Value = .Sheets("tissus sec").Range("C" & r2.Row).Value
            .Sheets("recherche").Range("J" & ligne).Value = .Sheets("tissus sec").Range("S" & r2.Row).Value
        End If
        .Sheets("recherche").Range("K" & ligne).Value = .Sheets("tissus sec").Range("V" & r2.Row).Value
        .Sheets("recherche").Range("L" & ligne).Value = .Sheets("tissus sec").Range("W" & r2.Row).Value
        occurence = occurence + 1
        ligne = ligne + 1
    End If 'récupère le nom de l'onglet
    
    Set r3 = ThisWorkbook.Sheets("consommable composite").Range("C:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Not r3 Is Nothing Then
        trouvé = True 'definit la variable trouvé
        MsgBox "Recherche effectuée dans l'onglet consommable composite"
        'occurence = 0
        'ligne = 2
        If occurence = 0 Then
            .Sheets("recherche").Range("B" & ligne).Value = .Sheets("consommable composite").Range("B" & r3.Row).Value
            .Sheets("recherche").Range("C" & ligne).Value = .Sheets("consommable composite").Range("A" & r3.Row).Value
            .Sheets("recherche").Range("D" & ligne).Value = .Sheets("consommable composite").Range("I" & r3.Row).Value
            .Sheets("recherche").Range("E" & ligne).Value = .Sheets("consommable composite").Range("J" & r3.Row).Value
            .Sheets("recherche").Range("F" & ligne).Value = .Sheets("consommable composite").Range("O" & r3.Row).Value
            .Sheets("recherche").Range("G" & ligne).Value = .Sheets("consommable composite").Range("M" & r3.Row).Value
            .Sheets("recherche").Range("H" & ligne).Value = .Sheets("consommable composite").Range("D" & r3.Row).Value
            .Sheets("recherche").Range("I" & ligne).Value = .Sheets("consommable composite").Range("C" & r3.Row).Value
            .Sheets("recherche").Range("J" & ligne).Value = .Sheets("consommable composite").Range("S" & r3.Row).Value
        End If
        .Sheets("recherche").Range("K" & ligne).Value = .Sheets("consommable composite").Range("V" & r3.Row).Value
        .Sheets("recherche").Range("L" & ligne).Value = .Sheets("consommable composite").Range("W" & r3.Row).Value
        occurence = occurence + 1
        ligne = ligne + 1
    End If
    
    Set r4 = ThisWorkbook.Sheets("résine").Range("C:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Not r4 Is Nothing Then
        trouvé = True 'definit la variable trouvé
        MsgBox "Recherche effectuée dans l'onglet résine"
        'occurence = 0
        'ligne = 2
        If occurence = 0 Then
            .Sheets("recherche").Range("B" & ligne).Value = .Sheets("résine").Range("B" & r4.Row).Value
            .Sheets("recherche").Range("C" & ligne).Value = .Sheets("résine").Range("A" & r4.Row).Value
            .Sheets("recherche").Range("D" & ligne).Value = .Sheets("résine").Range("I" & r4.Row).Value
            .Sheets("recherche").Range("E" & ligne).Value = .Sheets("résine").Range("J" & r4.Row).Value
            .Sheets("recherche").Range("F" & ligne).Value = .Sheets("résine").Range("O" & r4.Row).Value
            .Sheets("recherche").Range("G" & ligne).Value = .Sheets("résine").Range("M" & r4.Row).Value
            .Sheets("recherche").Range("H" & ligne).Value = .Sheets("résine").Range("D" & r4.Row).Value
            .Sheets("recherche").Range("I" & ligne).Value = .Sheets("résine").Range("C" & r4.Row).Value
            .Sheets("recherche").Range("J" & ligne).Value = .Sheets("résine").Range("S" & r4.Row).Value
        End If
        .Sheets("recherche").Range("K" & ligne).Value = .Sheets("résine").Range("V" & r4.Row).Value
        .Sheets("recherche").Range("L" & ligne).Value = .Sheets("résine").Range("W" & r4.Row).Value
        occurence = occurence + 1
        ligne = ligne + 1
    End If
    If trouvé = False Then MsgBox ("Aucune information trouvée")
    Unload Me
End If
End Sub

Voila ce que fait ce code :
Recherche 1 :
• il vérifie que TBNumLot ne soit pas vide (si TBNumLot est vide la macro s'arrête)
• il recherche TBNumLot dans les colonnes C et D de l'onglet prépreg.
Si il trouve, trouvé = Vrai, message, l'onglet recherche récupère des données de l'onglet prépreg relatives à la ligne de la première occurrence trouvé...
• les variables ligne (pour celle-là je comprends) et occurrence sont incrémentées
Recherche 2 ,Recherche 3 et Recherche 4 idem à Recherche 1... sauf que comme la variable occurrence n'est plus nulle, seules les colonne K et L récupère les données.

 
Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
348
patricktoulon
patricktoulon
A
  • Question Question
XL 2010 Filtrer un Combobox en VBA excel
2 3
Réponses
43
Affichages
2 K
Dranreb
Dranreb
thunder23
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
648
thunder23
thunder23
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
1 K
CortoXls
C
lestoiles1
  • Question Question
XL 2013 Sub commentaire
Réponses
2
Affichages
329
lestoiles1
lestoiles1
E
  • Résolu(e)
Microsoft 365 Reduire Temps Execution Code
Réponses
5
Affichages
371
eric72
E
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
375
sebastien176
S
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
617
KRUG WOO
K
N
  • Résolu(e)
XL 2021 comment faire recherche dans une colonne et ligne
Réponses
5
Affichages
641
job75
job75
klin89
  • Question Question
Microsoft 365 Méthode Evaluate pour se dispenser d'une boucle imbriquée
Réponses
14
Affichages
680
patricktoulon
patricktoulon
M
  • Question Question
XL 2013 MACRO VBA pour imprimer tous les bulletins d'un établissement scolaire
Réponses
4
Affichages
686
MBEPID
M
G
  • Résolu(e)
XL 2010 Obliger la validation d'un bouton d'option.
Réponses
8
Affichages
466
gillesda
G
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
1 K
Gestionnaire_rh
G
N
  • Résolu(e)
Microsoft 365 Modification impossible d'une TextBox
2 3 4
Réponses
56
Affichages
2 K
NONO14
N
lynyrd
  • Question Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
833
AtTheOne
AtTheOne
Jojo973
  • Question Question
Microsoft 365 Trier des données et les afficher sur une autre feuille
Réponses
10
Affichages
588
Jojo973
Jojo973
E
  • Résolu(e)
Microsoft 365 Copier Coller selon condition
Réponses
5
Affichages
373
TooFatBoy
TooFatBoy
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
606
sebastien176
S
G
  • Question Question
XL 2021 Macro pour changer les titres de fichier d'archive
Réponses
3
Affichages
599
fanch55
fanch55
E
  • Résolu(e)
XL 2019 chercher une date dans une colonne vba
Réponses
12
Affichages
753
sylvanu
sylvanu
Retour