code de recherche ?

[jool]

bonjour,

J'ai un tableau avec en colonne A des dates format jj/mm/aaaa, en colonne B des kilomètres, et en C des litres (pour faire un suivi consommation véhicules).

Je souhaiterais par le biais d'un userform, dans lequel je rentre le véhicule dans combobox1, et une date dans label1, que dans listbox1 s'affiche la date ainsi que les kms et litres.

j'ai récupéré ce code, mais que faut-il modifier pour que la recherche :

1 - Se fasse dans la feuille ouverte,

2 - De A1 à A65536 ? (dates format jj/mm/aaaa)

Merci.

Private Sub CommandButton1_Click()
Dim Sh As Worksheet
On Error Resume Next
Set Sh = Sheets(ComboBox1.Value)
If Err Then MsgBox "Feuille introuvable", 48: ComboBox1.DropDown: Exit Sub 'en cas d'entrée manuelle incorrecte
On Error GoTo 0
Sh.Visible = True 'en cas de feuille masquée
Sh.Activate


Dim C As Range
Dim Tablo() As String
Dim Text As String
Dim S As Byte
Dim Firstaddress As String
Dim i As Integer, X As Integer, L As Integer

Text = Me.TextBox1
If Text = "" Then Exit Sub

For S = 1 To Worksheets.Count
If Worksheets(S).Name <> "HOME" Then
With Sheets(S).UsedRange
Set C = .Find(Text, LookIn:=xlValues, LookAt:=xlPart)
If Not C Is Nothing Then
Firstaddress = C.Address
Do
ReDim Preserve Tablo(8, i)
For X = 1 To 6
Tablo(X - 1, i) = C.Offset(0, X - C.Column).Text
Next X
Tablo(6, i) = Sheets(S).Name
Tablo(7, i) = C.Address(0, 0)
i = i + 1
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Firstaddress
End If
End With
End If
Next S
If i = 0 Then
MsgBox "Le Texte " & Text & " n'a pas été trouvé" & vbCrLf & "Faites un essai sur une partie du nom", vbCritical, Sign
Exit Sub
End If
Me.ListBox1.Column() = Tablo()
End Sub

 

[job75]

Re : code de recherche ?

Bonjour jool,

Je suppose qu'il y a un rapport avec ce fil :

https://www.excel-downloads.com/threads/recherche-par-userform.119846/

Quand donc certains XLDnautes comprendront-ils qu'ouvrir 36 posts sur le même sujet agace tout le monde et dénonce un esprit plutôt bordélique ?

A+

 

[jool]

Re : code de recherche ?

Désolé du bordel, c'est une erreur de ma part.

Quand donc certains parisiens comprendront que sur une autoroute à 3 voies, la voie du milieu sert à doubler et qu'ils peuvent circuler sur la voie de droite ? lol

 

[job75]

Re : code de recherche ?

Re,

Désolé du bordel, c'est une erreur de ma part

Oui une erreur évidemment. Il y a aussi ce post d'il y a 4 jours :

https://www.excel-downloads.com/threads/recherche-dans-tableau-par-userform.119608/

Et oublier de joindre un fichier (au format .xls), une erreur aussi.

Nota : doubler par la droite sur l'autoroute, c'est très dangereux - et bordélique.

A+

 

[jool]

Re : code de recherche ?

tout à fait d'accord pour ce qui est de doubler à droite, par contre poster un fichier joint n'est pas obligatoire surtout si tu n'as pas un bon anti-virus, et je dirais pour terminer que tes commentaires qui ne sont pas des réponses à ma question, ajoutent un coté bordélique à cette discussion et n'enrichissent pas le forum.

A+.

 

[Robert]

Re : code de recherche ?

Bonjour le fil, bonjour le forum,

Je pense qu'un fichier en pièce jointe nous permettrait de t'aider bien plus vite car il nous éviterait d'avoir à tout créer nous même. Maintenant si c'est trop te demander... Ça ne sera qu'un commentaire de plus ajoutant un coté bordélique à cette discussion et n'enrichissant pas le forum.

 

[bqtr]

Re : code de recherche ?

Bonsoir jool, job75, Robert

Essaye ceci : code d'un bouton sur le USF nommé B_GO

Private Sub B_GO_Click()

Dim c As Range, premier As String, i As Long

With ListBox1
  .Clear
  .ColumnCount = 3
End With

With Range("A1:A" & Range("A65536").End(xlUp).Row)
   Set c = .Find(CDate(Me.Label1), LookIn:=xlValues)
   If Not c Is Nothing Then
       premier = c.Address
       Do
          Me.ListBox1.AddItem c.Value
          Me.ListBox1.Column(1, i) = c.Offset(0, 1).Value
          Me.ListBox1.Column(2, i) = c.Offset(0, 2).Value
          Set c = .FindNext(c)
          i = i + 1
       Loop While Not c Is Nothing And c.Address <> premier
   End If
End With

If i = 0 Then MsgBox "La Date : " & Me.Label1 & " n'a pas été trouvée" & vbCrLf & "Modifier la la date", vbCritical, "Erreur :"

End Sub

Le code travaille sur la feuille active.

La feuille active correspond à la voiture sélectionnée dans le combobox1 ?
Si c'est le cas, elle est activée quand tu sélectionnes la voiture ?

Il n'y a pas de test pour savoir si c'est bien une date qui est entrée dans le Label1

Si tu mets un fichier en PJ, pense à le mettre au format xls, pas au format Excel 2007

Bonne soirée

A+

 

[MJ13]

Re : code de recherche ?

Bonjour à tous

jool: Je persiste et je signe quand on dit:

Je souhaiterais par le biais d'un userform, dans lequel je rentre le véhicule dans combobox1, et une date dans label1, que dans listbox1 s'affiche la date ainsi que les kms et litres.

Il faut un fichier avec le USF sans données confidentielles (cela me rappelle un post récent!), sinon c'est une perte de temps pour ceux qui pourraient t'aider.

 

[jool]

Re : code de recherche ?

bonjour à tous,

Je suis d'accord MJ13, mais il y a l'art et la manière de dire et d'expliquer les choses.

Merci bqtr, j'ai essayé mais sans résultat.

j'ai mis un fichier joint.

 

[jool]

Re : code de recherche ?

voici le code modifié, et ça fonctionne :

Private Sub CommandButton1_Click()

Dim Sh As Worksheet
On Error Resume Next
Set Sh = Sheets(ComboBox1.Value)
If Err Then MsgBox "Feuille introuvable", 48: ComboBox1.DropDown: Exit Sub 'en cas d'entrée manuelle incorrecte
On Error GoTo 0
Sh.Visible = True 'en cas de feuille masquée
Sh.Activate

Dim c As Range, premier As String, i As Long

With ListBox1
.Clear
.ColumnCount = 4
End With
Text = Me.TextBox1
If Text = "" Then Exit Sub
With Range("A22" & Range("A65536").End(xlUp).Row)
Set c = .Find(CDate(Me.TextBox1), LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
premier = c.Address
Do
Me.ListBox1.AddItem c.Value
Me.ListBox1.Column(1, i) = c.Offset(0, 1).Value
Me.ListBox1.Column(2, i) = c.Offset(0, 2).Value
Me.ListBox1.Column(3, i) = c.Offset(0, 3).Value
Set c = .FindNext(c)
i = i + 1
Loop While Not c Is Nothing And c.Address <> premier
End If
End With

If i = 0 Then MsgBox "La Date : " & Me.TextBox1 & " n'a pas été trouvée" & vbCrLf & "Modifiez la date", vbCritical, "Erreur :"

End Sub

 

[bqtr]

Re : code de recherche ?

Re,

Effectivement ca pouvait pas fonctionner

Un exemple en PJ

A+