Moteur de recherche vba userform

Moteur de recherche vba userform - VB/VBA/VBS - Programmation

Marsh Posté le 13-03-2014 à 08:26:21    

Bonjour à tous,  
 
J'ai créé un fichier excel avec un userform appelé Resultat dont l'objectif est de rentrer des données de dégustations dans un userform, qu'elle s'enregistrent sur une feuille excel et qu'on puisse les retrouver facilement pour les modifier et les enregistrer à une autre date.
La deuxième fonction importante est la fonction recherche qui se fait par projet (Colonne A feuille Recap) alors que je voudrais qu'elle se fasse par N° de produit (colonne C feuille Recap). En effet un numéro de produit ne revient qu'une seule fois alors qu'un projet revient plusieurs fois.
On recherche un N° de produit (colonne C feuille Recap) et on modifie les commentaires de dégustation et la date, on ajoute à la suite du tableau.
Autre pb : le moteur de recherche n'accepte pas les espaces.
 
Merci bcp pour votre aide !!!!!!
 
Option Explicit
Option Base 1
Option Compare Text
Public aa
Public mem1 As Boolean
 
 
 
Private Sub ListBox1_Click()
 
Dim cptr As Byte, Article As String, lig As Byte
 
 
        For cptr = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(cptr) = True Then
          Article = ListBox1.List(ListBox1.ListIndex, 0)
          With Sheets("Recap" )
           lig = .Columns("A" ).Find(Article, .Range("A1" ), xlValues).Row
           T2 = .Cells(lig, "A" )
           T3 = .Cells(lig, "B" )
           T4 = .Cells(lig, "C" )
           T5 = .Cells(lig, "D" )
           Texture = .Cells(lig, "G" )
           Aspect = .Cells(lig, "H" )
           Goût = .Cells(lig, "I" )
                 
        End With
        End If
     Next
     
 
     
End Sub
 
Private Sub T1_Change()  'T1 = moteur recherche !'    
 Dim i&, fin&, y&, a&, mem As Boolean
    Application.ScreenUpdating = 0
    If mem1 Then Exit Sub
    If T1 = "" Then ListBox1.Clear: T2 = "": T3 = "": T4 = "": T5 = "":  Aspect = "": Texture = "": Goût = "": C3.Visible = 0: Exit Sub
    ListBox1.Clear
 
     
    With Feuil1
        y = 1
        fin = .Range("A" & Rows.Count).End(xlUp).Row
        aa = .Range("A2:F" & fin)
    End With
    For i = 1 To UBound(aa)
        aa(i, 5) = i + 1
    Next i
    For i = 1 To UBound(aa)
        For a = 1 To UBound(aa, 2)
            If aa(i, a) Like "*" & T1 & "*" Then aa(i, 6) = "oui": y = y + 1: Exit For
        Next a
    Next i
    If y = 1 Then Exit Sub
    If y = 2 Then
        For i = 1 To UBound(aa)
            If aa(i, 6) = "oui" Then
                ListBox1.AddItem aa(i, 1)
                For a = 1 To UBound(aa, 2) - 2
                    ListBox1.List(ListBox1.ListCount - 1, a - 1) = aa(i, a)
                    Controls("T" & a + 1) = aa(i, a)
                Next a
                mem = 1: Exit For
            End If
        Next i
    Else
        ReDim bb(y - 1, UBound(aa, 2) - 1)
        y = 1
        For i = 1 To UBound(aa)
            If aa(i, 6) = "oui" Then
                For a = 1 To UBound(aa, 2) - 1
                    bb(y, a) = aa(i, a)
                Next a
                y = y + 1
            End If
        Next i
    End If
    With ListBox1
        .ColumnCount = 5
        .ColumnWidths = "80;80;50;80;0"
        If mem Then Exit Sub
        .List = bb
    End With
End Sub
 
 
 
Private Sub CommandButton3_Click()
'AJOUTER'    
Dim L As Integer
   
 
 
    If MsgBox("Confirmez-vous l’insertion ?", vbYesNo, "Demande de confirmation d’ajout" ) = vbYes Then
 
        L = Sheets("Recap" ).Range("a65536" ).End(xlUp).Row + 1
        'Pour placer le nouvel enregistrement à la première ligne de tableau non vide'
 
        Range("A" & L).Value = T2
        Range("B" & L).Value = T3
        Range("C" & L).Value = T4
        Range("D" & L).Value = T5
        Range("G" & L).Value = Aspect
        Range("H" & L).Value = Texture
        Range("I" & L).Value = Goût
         Range("K" & L).Value = LabelMois
         
Clear:    T2 = "": T3 = "": T4 = "": T5 = "":  Aspect = "": Texture = "": Goût = "": C3.Visible = 0:  LabelMois.Visible = 0: Exit Sub
 
         
    End If
 
 
End Sub

Reply

Marsh Posté le 13-03-2014 à 08:26:21   

Reply

Marsh Posté le 19-03-2014 à 15:51:48    

Bonjour,
 
J'ai trouvé une solution, je donne un numéro d'insertion à chaque nouvelle dégustation.
 
Comment ajouter la colone E dans ma listbox1?
 
Merci à tous

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed