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

P

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
 
Trier par date Trier par votes
Pierrot93

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
Cliquez pour agrandir...

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

bonne journée
@+
 
Vote positif 0 Vote négatif
P

PEX

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

Pierrot93 à dit:
Re,



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

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é
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
108
sebastien176
S
G
  • Résolu(e)
XL 2010 Obliger la validation d'un bouton d'option.
Réponses
8
Affichages
290
gillesda
G
N
  • Résolu(e)
XL 2021 comment faire recherche dans une colonne et ligne
Réponses
5
Affichages
306
job75
job75
L
  • Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
295
AtTheOne
AtTheOne
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
325
sebastien176
S
E
  • Résolu(e)
Microsoft 365 Copier Coller selon condition
Réponses
5
Affichages
192
TooFatBoy
TooFatBoy
yojema
  • Question
XL 2021 faire évoluer un code VBA
Réponses
3
Affichages
380
Dranreb
Dranreb
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
1 K
Dranreb
Dranreb
G
  • Question
Microsoft 365 Export données
Réponses
4
Affichages
418
GClaire
G
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
2 K
thivame
T

Membres actuellement en ligne

14 membres et 139 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
314 635
Messages
2 111 453
Membres
111 144
dernier inscrit
shura_77