Discussion :

[g.dep]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

If ActiveCell.Text Like "*NANTAIS*" Then

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[EricDgn]

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[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

[MarcelG]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[MarcelG]

Salut,

Mieux.

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[Philippe Tulliez]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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