Champ de recherche VBA [Résolu/Fermé]

Messages postés
10
Date d'inscription
vendredi 10 octobre 2014
Statut
Membre
Dernière intervention
18 mars 2015
-




Bonjour tout le monde,

Voilà je viens vers vous, car je rencontre un problème avec ma zone de recherche VBA je vais essayer d'être claire au maximum afin que vous puissiez m'aider.
En A2 j'ai concaténé B2 et C2 afin d'avoir le nom et prénom dans une même cellule. En D3 j'ai une formule : =SI(ESTVIDE(D2);"";D2+1) afin d'obtenir un nouveau numéro de dossier à chaque saisie d'un salarié. En E2 j'ai une créer une formule afin que tous les 15 dossiers un nouveau numéro soit calculé. Ci-dessous ma VBA. Elle fonctionne très bien et j'ai bien le nom et prénom des salariés qui s'affichent dans ma ListBox sauf que je souhaiterais qu'en plus de l'affichage du nom et prénom apparaissent le numéro du dossier (D3) et le numéro de la boite à archive (E2). Je souhaiterais avoir aussi les cellules des colonnes D et E en fond vert comme pour ma première colonne. Je suis novice en VBA mais je pense que ce n'est pas grand-chose, mais quand on ne sait pas, on ne sait pas ^^. J'espère que mes explications ne sont pas trop farfelues. J'attends vos retours avec impatience merci par avance pour celui ou ceux qui voudront bien m'accorder quelques minutes.

Option Compare Text

Private Sub TextBox21_Change()

    Application.ScreenUpdating = False

    Range("A2:A1000").Interior.ColorIndex = 2
    ListBox1.Clear
        
    If TextBox21 <> "" Then
    
        For ligne = 2 To 1000
            If Cells(ligne, 1) Like "*" & TextBox21 & "*" Then
                Cells(ligne, 1).Interior.ColorIndex = 43
                ListBox1.AddItem Cells(ligne, 1)
            End If
            
            Next
    End If
    
End Sub
Afficher la suite 

2 réponses

Messages postés
1064
Date d'inscription
jeudi 20 juin 2013
Statut
Membre
Dernière intervention
22 décembre 2017
105
0
Merci
Bonjour
Essayez donc cela :

Private Sub test()
  Application.ScreenUpdating = False
  Range("A2").Select ' on se positionne en A2
  ListBox1.Clear

  If TextBox21 <> "" Then
    Do While ActiveCell.Value <> "" ' tant que la cellule active n'est pas vide on entre dans la boucle
      If ActiveCell.Value Like "*" & TextBox21 & "*" Then
        ActiveCell.Interior.ColorIndex = 43               ' cellule active en vert
        ActiveCell.Offset(0, 3).Interior.ColorIndex = 43  ' cellule active décallé de 3 colonnes en vert
        ActiveCell.Offset(0, 4).Interior.ColorIndex = 43  ' cellule active décallé de 4 colonnes en vert
      End If
      ActiveCell.Offset(1, 0).Select ' on descend d'une ligne
    Loop
  End If
End Sub


Cordialement
samydidi31
Messages postés
10
Date d'inscription
vendredi 10 octobre 2014
Statut
Membre
Dernière intervention
18 mars 2015
-
Merci beaucoup mais ça ne fonctionne pas et je ne serais pas capable de vous dire où ça coince.
Messages postés
12253
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
19 juillet 2019
2192
0
Merci
Bonjour,

Essayez ceci :
Option Compare Text

Private Sub TextBox21_Change()

    Application.ScreenUpdating = False

    Range("A2:A1000").Interior.ColorIndex = 2
    ListBox1.Clear
    'ListBox multicolonnes :
    ListBox1.ColumnCount = 3
        
    If TextBox21 <> "" Then
    
        For ligne = 2 To 1000
            If Cells(ligne, 1) Like "*" & TextBox21 & "*" Then
                'colore toute la plage de A à E
                Range("A" & ligne & ":E" & ligne).Interior.ColorIndex = 43
                ListBox1.AddItem Cells(ligne, 1)
                'Ajout des données des colonnes D et E
                ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(ligne, 4)
                ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(ligne, 5)
            End If
            
            Next
    End If
    
End Sub

Thorak83
Messages postés
1064
Date d'inscription
jeudi 20 juin 2013
Statut
Membre
Dernière intervention
22 décembre 2017
105 -
oups

Option Compare Text

Private Sub TextBox21_Change()
  Application.ScreenUpdating = False
  Range("A2").Select ' on se positionne en A2
  ListBox1.Clear

  If TextBox21 <> "" Then
    Do While ActiveCell.Value <> "" ' tant que la cellule active n'est pas vide on entre dans la boucle
      If ActiveCell.Value Like "*" & TextBox21 & "*" Then
        ActiveCell.Interior.ColorIndex = 43               ' cellule active en vert
        ActiveCell.Offset(0, 3).Interior.ColorIndex = 43  ' cellule active décallé de 3 colonnes en vert
        ActiveCell.Offset(0, 4).Interior.ColorIndex = 43  ' cellule active décallé de 4 colonnes en vert
        ListBox1.AddItem ActiveCell.Value
      End If
      ActiveCell.Offset(1, 0).Select ' on descend d'une ligne
    Loop
  End If   
End Sub
samydidi31
Messages postés
10
Date d'inscription
vendredi 10 octobre 2014
Statut
Membre
Dernière intervention
18 mars 2015
> Thorak83
Messages postés
1064
Date d'inscription
jeudi 20 juin 2013
Statut
Membre
Dernière intervention
22 décembre 2017
-
Super !!! Ça fonctionne nickel. Merci beaucoup