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
