copier toutes les lignes contenant un mot

[miss34]

Bonjour,

je suis débutante en Excel et pour un projet professionnel je dois réaliser une chose que je ne sais pas faire.

Je vous joins un ficher test.

En fait, J'aimerais que sur la première feuille on saisisse le nom d'une personne que l'on recherche (sur un tableau se trouvant sur la 2eme feuille) et que :
-soit ça ouvre une boite de dialogue pour saisir un prénom si 2 personnes sont trouvées avec le même nom, et que ça note toutes les données sur lui par la suite
-soit que ça affiche directement les différentes lignes contenant ce nom.

Je ne sais vraiment pas comment faire.

Merci de votre aide et si je ne suis pas claire, n’hésitez pas à me demander des précisions.

 

[zeltron24]

Re : copier toutes les lignes contenant un mot

Bonjour miss34

Un début peut être qui pourrait vous convenir.

 

[miss34]

Re : copier toutes les lignes contenant un mot

l'idée est bien mais le fichier que j'ai mis est un exemple et dans mon document il y a 200 noms donc la liste déroulante c'est pas le top je pense. C'est pour ça que je pensais faire une case où on saisi le nom et pas une liste déroulante.

 

[job75]

Re : copier toutes les lignes contenant un mot

Bonjour miss34, zeltron24,

C'est un problème classique avec de nombreux exemples sur le forum.

Il se règle assez facilement par formule matricielle, voyez le fichier joint.

A+

 

[miss34]

Re : copier toutes les lignes contenant un mot

Merci à tous les deux d'avoir pris du temps. Ça fonctionne parfaitement.

 

[job75]

Re : copier toutes les lignes contenant un mot

Bonjour miss34, le forum,

Quelques améliorations dans les fichiers joints.

Fichier (2) restitution en colonnes, fichier (2 bis) restitution en lignes.

Bonne journée.

 

[job75]

Re : copier toutes les lignes contenant un mot

Re,

Maintenant une solution VBA qui permet de rechercher une chaîne de caractère quelconque dans la base de données.

Dans ThisWorkbook :

Private Sub Workbook_Open()
Feuil1.TextBox1 = "" 'CodeName de la feuille
End Sub

Dans le code de la feuille :

Option Compare Text 'la casse est ignorée

Private Sub TextBox1_Change()
Dim P As Range, t$, j As Byte, cw$, i&, n&, a(), k As Byte
Set P = Intersect(Feuil2.Range("B3:E" & Rows.Count), Feuil2.UsedRange)
t = TextBox1
If Not P Is Nothing And t <> "" Then
  '---largeur des colonnes---
  For j = 2 To 4
    cw = cw & Cells(1, j).Columns.Width & ";"
  Next j
  ListBox1.ColumnWidths = cw
  '---création du tableau a---
  For i = 1 To P.Rows.Count
    For j = 1 To 4
      If InStr(P(i, j).Text, t) Then
        n = n + 1
        ReDim Preserve a(1 To 4, 1 To n) 'base 1
        For k = 1 To 4
          a(k, n) = P(i, k).Text
        Next k
        Exit For 'ligne suivante
      End If
    Next j
  Next i
End If
'---restitution---
If n = 1 Then ReDim Preserve a(1 To 4, 1 To n + 1) '2 lignes
With ListBox1
  If n Then .List = Application.Transpose(a)
  .Visible = n
End With
End Sub

Fichier joint.

A+

 

[job75]

Re : copier toutes les lignes contenant un mot

Re,

On peut préférer restituer directement dans la feuille :

Option Compare Text 'la casse est ignorée

Private Sub TextBox1_Change()
Dim P As Range, t$, i&, j As Byte, n&, a(), k As Byte
Set P = Intersect(Feuil2.Range("B3:E" & Rows.Count), Feuil2.UsedRange)
t = TextBox1
If Not P Is Nothing And t <> "" Then
  '---création du tableau a---
  For i = 1 To P.Rows.Count
    For j = 1 To 4
      If InStr(P(i, j).Text, t) Then
        n = n + 1
        ReDim Preserve a(1 To 4, 1 To n) 'base 1
        For k = 1 To 4
          a(k, n) = P(i, k)
        Next k
        Exit For 'ligne suivante
      End If
    Next j
  Next i
End If
'---restitution dans la feuille---
With [B8] 'à adapter
  If n Then .Resize(n, 4) = Application.Transpose(a)
  .Offset(n).Resize(Rows.Count - n - .Row + 1, 4).Delete xlUp
End With
End Sub

Fichier (2).

Edit : j'ai figé les 7 premières lignes.

A+