Saisie et recherche

Bonjour à tous.

Après avoir "piocher" un peu partout sur le Net, j'ai créer créer un fichier en assemblant plusieurs codes.

Ce classeur comporte :

• un userForm de saisie, (fonctionnel).
• un autre de recherche qui me pose des soucis avec l'affichage des données dans le listview. Si cela fonctionne dans la récupération des données, je n'ai pas celles que j'aimerai obtenir dans les colonnes respectives. J'ai tenté plusieurs modifications sans succès. De plus, la colonne du nom de la feuille ne m'est pas nécessaire et je n'arrive pas à la supprimer. (Dans les différents classeurs sur le sujet pas de codage identique).

Licaon

Salut Licaon,

Voici les codes rectifiés de ton USF recherche

'ICI C'est la mise en place initialisation
Private Sub UserForm_Initialize()
'pour la date du jour
  Me.Caption = Format(Date, "dddd dd mmmm yyyy")
  With ListBox1
    .ColumnCount = 54  ' de A à D = 4 colonnes + 1 pour la cellule
    '.ColumnWidths = "150;100;0;80;80;70;0"
    .ColumnWidths = "100;100;80;80;0"
  End With
  Me.CommandButton1.Default = True

  ' pour définir la couleur des objets lors de l'initialisation d'un UserForm.
  With RECHERCHETOUS
    .BackColor = &H8000000F
    .CommandButton1.BackColor = &H8000000F
    .CommandButton3.BackColor = &H8000000F
    .CommandButton2.BackColor = &H8000000F
    '.Label3.BackColor = &H8000000F
  End With
End Sub

'ICI C'est le Moteur de Recherche
Private Sub CommandButton1_Click()
  Dim F As Worksheet
  Dim Plage As Range, C As Range
  Dim T As String, Firstaddress As String
  Dim x As Integer
  ListBox1.Clear
  T = Me.TextBox1
  If T = "" Then Exit Sub
  ' Pour chaque feuille du classeur
  For Each F In Worksheets
    ' Avec la feuille F
    With F
      ' FAUX
      'Set Plage = Application.Intersect(.UsedRange.Cells, .Range(.Cells(8, 1), .Cells(.Rows.Count, .Columns.Count)))
      ' Commencer la recherche à partir de la ligne 3 de la colonne 1
      Set Plage = Application.Intersect(.UsedRange.Cells, .Range(.Cells(3, 1), .Cells(.Rows.Count, .Columns.Count)))
    End With
    ' Trouver la cellule contenant la valeur et l'attibuer à C
    Set C = Plage.Find(T, LookIn:=xlValues, LookAt:=xlPart)
    ' Si C n'est pas vide = valeur trouvée
    If Not C Is Nothing Then
      ' Première adresse = adresse de la cellule
      Firstaddress = C.Address
      ' Faire
      Do
        ' Avec la ListBox
        With ListBox1
          ' Ajouter un item avec la date
          .AddItem F.Cells(C.Row, 1).Text
          ' Pour chaque colonne suivante de 2 à 4
          For x = 2 To 4
            ' Ajouter la valeur de la cellule
            .List(.ListCount - 1, x - 1) = F.Cells(C.Row, x).Text
          Next x
          ' Ajouter l'adresse dans la 5ème
          .List(.ListCount - 1, 5) = C.Address(False, False)
        End With
        ' Trouver la prochaine cellule contenant la valeur
        Set C = Plage.FindNext(C)
        ' On continue, tant que cellule trouvée et que son adresse <> de la 1ère
      Loop While Not C Is Nothing And C.Address <> Firstaddress
    End If
  Next F

  If ListBox1.ListCount = 0 Then
    MsgBox "Le Texte " & T & " n'a pas été trouvé" & vbLf & "Faites un essai sur une partie du nom", vbCritical, Sign
  End If
End Sub

A+

Bonsoir et merci BrunoM45 pour cette réponse rapide.

Cela fonctionne bien, mais, il y a toujours un mais.

J'ai fourni un fichier avec une seule feuille, (Feuil1). Je souhaite y transférer les données recueillies dans la Feuil2 et quand j'ajoute cette fameuse feuille j'ai le message suivant :

Erreur d’exécution "91", Variable objet ou variable de bloc With non définie.

A force de chercher, je me perds dans le code.

Est-il possible de m'aider encore ?

Merci.

Licaon

bonjour Licaon

non testé a essayer

Private Sub CommandButton4_Click()

    Dim L As Long

    With Worksheets("Feuil2")
        L = .Range("A65536").End(xlUp).Row
        For i = 1 To Me.ListView1.ListItems.Count
            .Range("A" & L + i).Value = Me.ListView1.ListItems(i).ListSubItems(1).Text
              If Me.ListView1.ListItems(i).ListSubItems(2).Text <> "" Then
                .Range("B" & L + i).Value = Me.ListView1.ListItems(i).ListSubItems(2).Text
            End If
            If Me.ListView1.ListItems(i).ListSubItems(3).Text <> "" Then
                .Range("D" & L + i).Value = Me.ListView1.ListItems(i).ListSubItems(3).Text
            End If
        End If
        End With
End Sub

Pascal

Bonjour le Forum.

Merci Grisan29 pour ce code.

Je ne peux pas le vérifier car lorsque j'ajoute la Feuil2, je me retrouve en débogage et je n'ai toujours pas trouvé la solution.

Bonne journée.

Licaon.

Bonjour à tous.

Je cherche toujours la solution à ce problème :

"J'ai fourni un fichier avec une seule feuille, (Feuil1). Je souhaite y transférer les données recueillies dans la Feuil2 et quand j'ajoute cette fameuse feuille j'ai le message suivant :

Erreur d’exécution "91", Variable objet ou variable de bloc With non définie.

Merci de m'aider à trouver la solution pour pouvoir continuer à élaborer cette application.

Bonjour

Modifies ta macro (lignes surlignées)

'ICI C'est le Moteur de Recherche
Private Sub CommandButton1_Click()
  Dim F As Worksheet
  Dim Plage As Range, C As Range
  Dim T As String, Firstaddress As String
  Dim x As Integer
  ListBox1.Clear
  T = Me.TextBox1
  If T = "" Then Exit Sub
  ' Pour chaque feuille du classeur
 For Each F In Worksheets
    ' Avec la feuille F
   With F
      ' FAUX
     'Set Plage = Application.Intersect(.UsedRange.Cells, .Range(.Cells(8, 1), .Cells(.Rows.Count, .Columns.Count)))
     ' Commencer la recherche à partir de la ligne 3 de la colonne 1
     Set Plage = Application.Intersect(.UsedRange.Cells, .Range(.Cells(3, 1), .Cells(.Rows.Count, .Columns.Count)))
    End With
   If Not Plage Is Nothing Then
      ' Trouver la cellule contenant la valeur et l'attibuer à C
      Set C = Plage.Find(T, LookIn:=xlValues, LookAt:=xlPart)
      ' Si C n'est pas vide = valeur trouvée
      If Not C Is Nothing Then
        ' Première adresse = adresse de la cellule
        Firstaddress = C.Address
        ' Faire
        Do
          ' Avec la ListBox
          With ListBox1
            ' Ajouter un item avec la date
            .AddItem F.Cells(C.Row, 1).Text
            ' Pour chaque colonne suivante de 2 à 4
            For x = 2 To 4
              ' Ajouter la valeur de la cellule
              .List(.ListCount - 1, x - 1) = F.Cells(C.Row, x).Text
            Next x
            ' Ajouter l'adresse dans la 5ème
            .List(.ListCount - 1, 5) = C.Address(False, False)
          End With
          ' Trouver la prochaine cellule contenant la valeur
          Set C = Plage.FindNext(C)
          ' On continue, tant que cellule trouvée et que son adresse <> de la 1ère
        Loop While Not C Is Nothing And C.Address <> Firstaddress
      End If
   End If
  Next F

  If ListBox1.ListCount = 0 Then
    MsgBox "Le Texte " & T & " n'a pas été trouvé" & vbLf & "Faites un essai sur une partie du nom", vbCritical, Sign
  End If
End Sub

Bonsoir Banzaï et merci de m'orienter.

Bonsoir le Forum.

Je n'arrive pas à comprendre ni à modifier ce code pour que la recherche ne se fasse que sur la Feuil1.

Mes connaissances sont tés limitées pour ce type de modification.

Est-il possible de me faire cette modification afin que je puisse la comprendre. Comme je l'ai déjà mentionné, chacun à sa logique de codage et je ne trouve pas pour m'aider à résoudre ce problème.

Merci pour votre participation.

Licaon

Bonsoir

A voir

Bonjour Banzaï, Bonjour le Forum.

Merci Banzaï pour ton aide.

Je vais prendre le temps de comparer les codes afin de comprendre là où j'étais coincé.

Cette formule fonctionne bien. Je vais pouvoir continuer cette application et affiner mon projet. Une recherche de données entre deux dates par deux DTPicker.

Merci encore

Licaon.