VBA Excel Recherche dans une liste

Version imprimable

1 pièce(s) jointe(s)

Bonjour,
Je désire effectuer une recherche dans une colonne comportant une partie du mot, les données seront retranscrits dans une autre feuille
j'ai donc ceci qui fonctionne

mais je désirerai l'insérere dans un userform avec zone de texte, il me faut donc remplacer "*NANTAIS*" par ma zone de texte

Code:

If ActiveCell.Text Like "*NANTAIS*" Then

mais je ne trouve pas la solution
Merci pour votre aide
Cordialement
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 EffaceFeui6 Sheets("Cuisine").Select Range("B1").Select Do While ActiveCell.Value <> "" If ActiveCell.Text Like "*NANTAIS*" Then 'recherche une partie du mot NANTAIS dans la cellule REFRE = ActiveCell.Value REFRECH = ActiveCell.Offset(0, 1).Value Sheets("Feuil6").Select 'ouvrir la feuille pour retranscrire les données Range("A1").Select Do While ActiveCell.Value <> "" ActiveCell.Offset(1, 0).Select Loop ActiveCell.Value = REFRE ActiveCell.Offset(0, 1).Value = REFRECH End If Sheets("Cuisine").Select ActiveCell.Offset(1, 0).Select Loop

1 pièce(s) jointe(s)

Bonjour,

Une façon de faire est que l'UserForm appelle la routine que vous avez faite (à améliorer):

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
'--- dans le module
Option Explicit
 
Public Sub CherchTxt(sTxt As String)
    Dim REFRE As Variant, REFRECH As Variant
    Sheets("Cuisine").Select
    Range("B1").Select
    If sTxt = "" Then Exit Sub
    sTxt = "*" & sTxt & "*"
    Do While ActiveCell.Value <> ""
        If ActiveCell.Text Like sTxt Then 'recherche partie du mot dans la cellule
            REFRE = ActiveCell.Value
            REFRECH = ActiveCell.Offset(0, 1).Value
            Sheets("Feuil6").Select 'ouvrir la feuille pour retranscrire les données
            Range("A1").Select
            Do While ActiveCell.Value <> ""
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveCell.Value = REFRE
            ActiveCell.Offset(0, 1).Value = REFRECH
        End If
        Sheets("Cuisine").Select
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub
 
Public Sub ShowUF()
    UserForm1.Show
End Sub
 
'--- dans l'UserForm
Private Sub CommandButton1_Click()
    CherchTxt Me.TextBox1.Value
End Sub

Cordialement.

24/09/2020, 18h41
g.dep

Bonsoir

Grand merci pour la réponse et la rapidité

c'est super cela fonctionne parfaitement

Encore grand merci

Félicitation bonne soirée

Bonsoir,

Ouh la!

Si tant est que le code est efficient, il n'en reste pas moins qu'il n'est pas très "propre"

Pas de déclaration de variable, des Select et ActiveCell à tout va.
Pire. Do While ... utilisé pour ce genre de méthode...

Juste en appliquant l'aide en ligne pour la méthode Find et un tant soit peu une variable Tableau.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Option Explicit
 
Public Sub Discussion_REFRE()
 
Dim dernl As Long
Dim c As Range
Dim firstaddress As String
Dim tablo() As Variant
Dim n As Long
 
With Worksheets("Cuisine")
    dernl = .Cells(.Rows.Count, 2).End(xlUp).Row
    With .Range("B1:B" & dernl)
        Set c = .Find("NANTAIS", LookIn:=xlValues, lookat:=xlPart)
        If Not c Is Nothing Then
            firstaddress = c.Address
            Do
                n = n + 1
                ReDim Preserve tablo(1 To n)
                tablo(n) = c.Value
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstaddress
        End If
    End With
End With
 
If Not c Is Nothing Then Set c = Nothing
 
Worksheets("Feuil6").Range("A1").Resize(UBound(tablo)).Value = Application.WorksheetFunction.Transpose(tablo)
 
End Sub

25/09/2020, 18h23
MarcelG
Salut,

Mieux.

S'il s'agit d'un tableau structuré, alors modifier le champ de recherche par
Code:

1 2 With Worksheets("Cuisine") With .Range("Tableau1[Nom]")
Attention!
Tu es nouveau (nous l'avons tous été), et développer ainsi est pour le moins légitime.
Sil n'y en avait qu'un, mon message est qu'il est utile, voire fondamental, surtout à ses débuts, de prendre de bonnes habitudes, notamment par la rigueur.
La technique s'acquière progressivement ensuite
(Consulte mon billet à ce sujet).

Je te souhaite une bonne continuation et te dis à bientôt.

Bonjour,
Une autre solution avec une fonction (GetArray) qui renvoie une table à une dimension et ne contenant que les chaînes contenant le mot cherché (pas de sensibilité à la casse)
Code:

1 2 3 4 5 6 7 8 Function GetArray(RangeColumn As Range, Optional ContainedString As String) ' Arguments ' RangeColumn Plage de cellule d'une colonne ' [ContainedString] Chaîne à filtrer, si vide la fonction renvoie la liste non filtrée Dim tbl() As Variant tbl = Application.Transpose(RangeColumn.Value) GetArray = Filter(tbl, ContainedString, True, vbTextCompare) End Function
Exemple d'utilisation du renvoi d'une liste filtrée.

Le tableau structuré se nomme T_Citation
La colonne a renvoyer comme liste à une dimension se nomme "Texte"
La liste à renvoyer doit contenir le mot Cheval (pas de sensibilité à la casse)

Lignes 9 à 12, alimentation de la liste du contrôle nommé ListBox1 et affichage du UserForm (UserForm1)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub TestGetArray() Dim oList As ListObject Dim rng As Range Dim Table() As String Set oList = Range("T_Citation").ListObject Set rng = oList.ListColumns("Texte").DataBodyRange Table = GetArray(rng, "Cheval") ' Retour de la liste filtrée ' Envoie la table dans le ListBox With UserForm1 .ListBox1.List = Table .Show End With Set oList = Nothing: Set rng = Nothing End Sub