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

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
P

PEX

XLDnaute Occasionnel
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
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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
P

PEX

XLDnaute Occasionnel
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
P

PEX

XLDnaute Occasionnel
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
P

PEX

XLDnaute Occasionnel
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
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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
Efgé

Efgé

XLDnaute Barbatruc
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
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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

Discussions similaires

S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
168
sebastien176
S
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
236
AtTheOne
AtTheOne
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
250
Francky79
F
yojema
  • Question
XL 2021 faire évoluer un code VBA
Réponses
3
Affichages
231
Dranreb
Dranreb
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
288
florian50470
F
F
  • Résolu(e)
Microsoft 365 Recherche à partir d'une TextBox
Réponses
4
Affichages
224
Francky79
F
E
  • Résolu(e)
XL 2019 inserer une valeur textbox dans la dernière cellule vide horizontalement
Réponses
7
Affichages
369
escudo
E
C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
613
Phil69970
Phil69970
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
303
Compte Supprimé 979
C
V
  • Résolu(e)
XL 2016 Exportation au format PDF à l'aide d'une macro : erreur 1004 'Document non enregistré'
Réponses
14
Affichages
664
Phil69970
Phil69970

Membres actuellement en ligne

9 membres et 73 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 677
Messages
2 090 820
Membres
104 676
dernier inscrit
akram1619