VBA boite de dialogue recherche probléme d'affichage des doublons

PEX

XLDnaute Occasionnel
bonjour a tous,

je m'en remet a vous car j'ai un soucis lors d'une recherche.
je suis en creation d'un fichier de gestion des stocks en passant par une macro.
le soucis vient d'une boite de dialogue de recherche qui a un probléme lorsque qu'il y a deux reference identique sur la meme feuille, par contre sur une recherche de tous le classeur si on a des valeurs identique dans des feuilles séparé la recherche les affiches .. je ne vois vraiment pas d'ou vient l'erreur.
je vous montre mon codage, aidé par XLTools qui m'a été d'un grand secours :

Code:
Private Sub Label_Alerte_Click()

End Sub

Private Sub quit_Click()
Label_Alerte = ""
Unload Me

End Sub

Private Sub save_click()

    Dim X, occurence As Integer
    Dim R As Range
    Dim ligne As Long
    Dim trouve As Boolean
    
    Dim trouvé As Boolean 'déclare la variable trouvé
    
    If TBNumLot.Value <> "" Then
    
        ThisWorkbook.Sheets("recherche").Range("B2:J" & ThisWorkbook.Sheets("recherche").Range("I:I").End(xlDown).Row).ClearContents
        
        trouve = False
        occurence = 0
        ligne = 2
        Label_Alerte = ""
               
        '=======================================================
        'Recherche parmi les numéro de lots client dans PréPreg
        '=======================================================
        Set R = ThisWorkbook.Sheets("prépreg").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
            trouve = True
            For Each R In ThisWorkbook.Sheets("prépreg").Range("C1:C" & ThisWorkbook.Sheets("prépreg").Range("C:C").End(xlDown).Row)
                If R.Text = TBNumLot.Value Then
                    With ThisWorkbook
                         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
                End If
            Next R
            occurence = 0
        End If
            
        '=======================================================
        'Recherche parmi les numéro de lots SAfran dans PréPreg
        '=======================================================
        Set R = ThisWorkbook.Sheets("prépreg").Range("D:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
            trouve = True
            For Each R In ThisWorkbook.Sheets("prépreg").Range("D1:D" & ThisWorkbook.Sheets("prépreg").Range("D:D").End(xlDown).Row)
                If R.Text = TBNumLot.Value Then
                    With ThisWorkbook
                         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
                End If
            Next R
            occurence = 0
        End If
            
        '=======================================================
        'Recherche parmi les numéro de lots dans Tissu Sec
        '=======================================================
        Set R = ThisWorkbook.Sheets("tissus sec").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
            trouve = True
            For Each R In ThisWorkbook.Sheets("tissus sec").Range("C1:C" & ThisWorkbook.Sheets("tissus sec").Range("C:C").End(xlDown).Row)
                If R.Text = TBNumLot.Value Then
                    With ThisWorkbook
                         If occurence = 0 Then
                            .Sheets("recherche").Range("B" & ligne).Value = .Sheets("tissus sec").Range("B" & R.Row).Value
                            .Sheets("recherche").Range("C" & ligne).Value = .Sheets("tissus sec").Range("A" & R.Row).Value
                            .Sheets("recherche").Range("D" & ligne).Value = .Sheets("tissus sec").Range("G" & R.Row).Value
                            .Sheets("recherche").Range("G" & ligne).Value = " #Pas de date# "
                            .Sheets("recherche").Range("H" & ligne).Value = .Sheets("tissus sec").Range("D" & R.Row).Value
                            .Sheets("recherche").Range("E" & ligne).Value = .Sheets("tissus sec").Range("H" & R.Row).Value
                            .Sheets("recherche").Range("F" & ligne).Value = .Sheets("tissus sec").Range("I" & R.Row).Value
                            .Sheets("recherche").Range("I" & ligne).Value = .Sheets("tissus sec").Range("C" & R.Row).Value
                            .Sheets("recherche").Range("J" & ligne).Value = .Sheets("tissus sec").Range("N" & R.Row).Value
                        End If
                            .Sheets("recherche").Range("K" & ligne).Value = .Sheets("tissus sec").Range("V" & R.Row).Value
                            .Sheets("recherche").Range("L" & ligne).Value = .Sheets("tissus sec").Range("W" & R.Row).Value
                            occurence = occurence + 1
                            ligne = ligne + 1
                    End With
                End If
            Next R
            occurence = 0
        End If
            
        '=====================================================================
        'Recherche parmi les numéro de lots client dans Consommable Composite
        '=====================================================================
        Set R = ThisWorkbook.Sheets("consommable composite").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
            trouve = True
            For Each R In ThisWorkbook.Sheets("consommable composite").Range("C1:C" & ThisWorkbook.Sheets("consommable composite").Range("C:C").End(xlDown).Row)
                If R.Text = TBNumLot.Value Then
                    With ThisWorkbook
                         If occurence = 0 Then
                            .Sheets("recherche").Range("B" & ligne).Value = .Sheets("consommable composite").Range("B" & R.Row).Value
                            .Sheets("recherche").Range("C" & ligne).Value = .Sheets("consommable composite").Range("A" & R.Row).Value
                            .Sheets("recherche").Range("D" & ligne).Value = .Sheets("consommable composite").Range("H" & R.Row).Value
                            .Sheets("recherche").Range("E" & ligne).Value = .Sheets("consommable composite").Range("I" & R.Row).Value
                            .Sheets("recherche").Range("F" & ligne).Value = .Sheets("consommable composite").Range("K" & R.Row).Value
                            .Sheets("recherche").Range("G" & ligne).Value = .Sheets("consommable composite").Range("F" & R.Row).Value
                            .Sheets("recherche").Range("H" & ligne).Value = .Sheets("consommable composite").Range("D" & R.Row).Value
                            .Sheets("recherche").Range("I" & ligne).Value = .Sheets("consommable composite").Range("C" & R.Row).Value
                            .Sheets("recherche").Range("J" & ligne).Value = .Sheets("consommable composite").Range("N" & R.Row).Value
                        End If
                            .Sheets("recherche").Range("K" & ligne).Value = .Sheets("consommable composite").Range("V" & R.Row).Value
                            .Sheets("recherche").Range("L" & ligne).Value = .Sheets("consommable composite").Range("W" & R.Row).Value
                            occurence = occurence + 1
                            ligne = ligne + 1
                    End With
                End If
            Next R
            occurence = 0
        End If
            
        '=====================================================================
        'Recherche parmi les numéro de lots SAfran dans Consommable Composite
        '=====================================================================
        Set R = ThisWorkbook.Sheets("consommable composite").Range("D:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
            trouve = True
            For Each R In ThisWorkbook.Sheets("consommable composite").Range("D1:D" & ThisWorkbook.Sheets("consommable composite").Range("D:D").End(xlDown).Row)
                If R.Text = TBNumLot.Value Then
                    With ThisWorkbook
                         If occurence = 0 Then
                            .Sheets("recherche").Range("B" & ligne).Value = .Sheets("consommable composite").Range("B" & R.Row).Value
                            .Sheets("recherche").Range("C" & ligne).Value = .Sheets("consommable composite").Range("A" & R.Row).Value
                            .Sheets("recherche").Range("D" & ligne).Value = .Sheets("consommable composite").Range("H" & R.Row).Value
                            .Sheets("recherche").Range("E" & ligne).Value = .Sheets("consommable composite").Range("I" & R.Row).Value
                            .Sheets("recherche").Range("F" & ligne).Value = .Sheets("consommable composite").Range("K" & R.Row).Value
                            .Sheets("recherche").Range("G" & ligne).Value = .Sheets("consommable composite").Range("F" & R.Row).Value
                            .Sheets("recherche").Range("H" & ligne).Value = .Sheets("consommable composite").Range("D" & R.Row).Value
                            .Sheets("recherche").Range("I" & ligne).Value = .Sheets("consommable composite").Range("C" & R.Row).Value
                            .Sheets("recherche").Range("J" & ligne).Value = .Sheets("consommable composite").Range("N" & R.Row).Value
                        End If
                            .Sheets("recherche").Range("K" & ligne).Value = .Sheets("consommable composite").Range("V" & R.Row).Value
                            .Sheets("recherche").Range("L" & ligne).Value = .Sheets("consommable composite").Range("W" & R.Row).Value
                            occurence = occurence + 1
                            ligne = ligne + 1
                    End With
                End If
            Next R
            occurence = 0
        End If
            
        '=======================================================
        'Recherche parmi les numéro de lots client dans Résine
        '=======================================================
        Set R = ThisWorkbook.Sheets("résine").Range("C:C").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
            trouve = True
            For Each R In ThisWorkbook.Sheets("résine").Range("C1:C" & ThisWorkbook.Sheets("résine").Range("C:C").End(xlDown).Row)
                If R.Text = TBNumLot.Value Then
                    With ThisWorkbook
                         If occurence = 0 Then
                            .Sheets("recherche").Range("B" & ligne).Value = .Sheets("résine").Range("B" & R.Row).Value
                            .Sheets("recherche").Range("C" & ligne).Value = .Sheets("résine").Range("A" & R.Row).Value
                            .Sheets("recherche").Range("D" & ligne).Value = .Sheets("résine").Range("H" & R.Row).Value
                            .Sheets("recherche").Range("E" & ligne).Value = .Sheets("résine").Range("I" & R.Row).Value
                            .Sheets("recherche").Range("F" & ligne).Value = .Sheets("résine").Range("J" & R.Row).Value
                            .Sheets("recherche").Range("G" & ligne).Value = .Sheets("résine").Range("F" & R.Row).Value
                            .Sheets("recherche").Range("H" & ligne).Value = .Sheets("résine").Range("D" & R.Row).Value
                            .Sheets("recherche").Range("I" & ligne).Value = .Sheets("résine").Range("C" & R.Row).Value
                            .Sheets("recherche").Range("J" & ligne).Value = .Sheets("résine").Range("N" & R.Row).Value
                        End If
                            .Sheets("recherche").Range("K" & ligne).Value = .Sheets("résine").Range("V" & R.Row).Value
                            .Sheets("recherche").Range("L" & ligne).Value = .Sheets("résine").Range("W" & R.Row).Value
                            occurence = occurence + 1
                            ligne = ligne + 1
                    End With
                End If
            Next R
            occurence = 0
        End If
            
        '=======================================================
        'Recherche parmi les numéro de lots SAfran dans Résine
        '=======================================================
        Set R = ThisWorkbook.Sheets("résine").Range("D:D").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
            trouve = True
            For Each R In ThisWorkbook.Sheets("résine").Range("D1:D" & ThisWorkbook.Sheets("résine").Range("D:D").End(xlDown).Row)
                If R.Text = TBNumLot.Value Then
                    With ThisWorkbook
                         If occurence = 0 Then
                            .Sheets("recherche").Range("B" & ligne).Value = .Sheets("résine").Range("B" & R.Row).Value
                            .Sheets("recherche").Range("C" & ligne).Value = .Sheets("résine").Range("A" & R.Row).Value
                            .Sheets("recherche").Range("D" & ligne).Value = .Sheets("résine").Range("H" & R.Row).Value
                            .Sheets("recherche").Range("E" & ligne).Value = .Sheets("résine").Range("I" & R.Row).Value
                            .Sheets("recherche").Range("F" & ligne).Value = .Sheets("résine").Range("J" & R.Row).Value
                            .Sheets("recherche").Range("G" & ligne).Value = .Sheets("résine").Range("F" & R.Row).Value
                            .Sheets("recherche").Range("H" & ligne).Value = .Sheets("résine").Range("D" & R.Row).Value
                            .Sheets("recherche").Range("I" & ligne).Value = .Sheets("résine").Range("C" & R.Row).Value
                            .Sheets("recherche").Range("J" & ligne).Value = .Sheets("résine").Range("N" & R.Row).Value
                        End If
                                                 End With
                End If
            Next R
            occurence = 0
        End If
        
        
        If trouve = False Then
            Label_Alerte = "Aucune information trouvée"
        Else
            ThisWorkbook.Sheets("recherche").Activate
            Unload Me
        End If
    Else
        Label_Alerte = "Renseignez le N° de Lot Client ou le N° de lot Safran"
    End If
    
End Sub

dans le code on voit deux colones :

Code:
.Sheets("recherche").Range("K" & ligne).Value = .Sheets("résine").Range("V" & R.Row).Value
                            .Sheets("recherche").Range("L" & ligne).Value = .Sheets("résine").Range("W" & R.Row).Value
                            occurence = occurence + 1
                            ligne = ligne + 1

je cherche a creer une boite de dialogue d'incrémentation je vous explique :

-> context : dans nos stock des produits sont stocké dans un congélateur. Pour l'utiliser on doit le sortir, donc le mettre a l'air ambiant. On souhaite avoir une trace de ces sortie afin de connaitre sa peremtion.

-> VBA : le but est grace a une recherche sur un produit, on ajoute au bout de sa ligne des colones V et W contenant le nombre d'heure de sortie ( colonne V ) et la date de sortie ( colone w ). le tout est rentrer dans des textbox.
Le probléme vient de l'incrémentation car le produit sera sortie a plusieur reprise, donc comment faire pour que les date de sortie et les heures s'affiche les unes sous les autre pour un meme produit ...

est-ce possible?

cordialement
 

Pierrot93

XLDnaute Barbatruc
Re : VBA boite de dialogue recherche probléme d'affichage des doublons

Bonjour,

pas tout compris... pour le problème ci-dessous :
le soucis vient d'une boite de dialogue de recherche qui a un probléme lorsque qu'il y a deux reference identique sur la meme feuille

regarde dans l'aide vba du coté de la méthode "findnext".

bonne journée
@+
 

PEX

XLDnaute Occasionnel
Re : VBA boite de dialogue recherche probléme d'affichage des doublons

Re,



comme dit plus haut, pour ce problème voir la méthode "findnext"...

ok je vais regarder,
la j'ai un soucis sur une fonction :

Code:
    [SIZE=4][B]If CBsecurite.Value <> "" Then[/B][/SIZE]    
        
        trouve = False
        occurence = 0
        ligne = 2
               
        '=======================================================
        'Recherche parmi les noms de produits securite
        '=======================================================
        Set R = ThisWorkbook.Sheets("sécurité").Range("B:B").Find(What:=CBsecurite.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
            trouve = True
            For Each R In ThisWorkbook.Sheets("sécurité").Range("B1:B" & ThisWorkbook.Sheets("sécurité").Range("B:B").End(xlDown).Row)
                If R.Text = CBsecurite.Value Then
                    With ThisWorkbook
                         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("recherche").Range("F" & ligne).Value = .Sheets("sécurité").Range("E" & R.Row).Value
                            .Sheets("recherche").Range("G" & ligne).Value = "###########"
                            .Sheets("recherche").Range("H" & ligne).Value = "###########"
                            .Sheets("recherche").Range("I" & ligne).Value = "###########"
                            .Sheets("recherche").Range("J" & ligne).Value = .Sheets("sécurité").Range("H" & R.Row).Value
                        End If
          End With
                End If
            Next R
            occurence = 0
        End If

pour la ligne en gras comment faire si j'ai une seconde Combox pour que si il n'ya rien dans cette combobox la recherche d'apres peut étre lancé
 
Haut Bas