afficher résultat dans textbox

Version imprimable

bonjour le forum !

Je fais une recherche et les résultats sont affiché dans une autre feuille.

J'aimerais savoir comment il serait possible d'afficher le résultat dans un textbox du userform ? (Car le recherche se lance à partir d'un textbox)

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
35
36
37
38
39
40
41
Private Sub CommandButton1_Click()
Dim FoundCount As Double
Dim rFoundB As Range, rFoundC As Range
Dim rFoundD As Range, MyTextB As String
Dim MyTextC As String, MyTextD As String
Dim B As Range, C As Range, D As Range
Dim rB As Range, rC As Range, rD As Range
MyTextB = Me.txtfindB.Value
txtresult.MultiLine = True
Sheets("Sheet2").Range("A2:f65536").ClearContents
 
 
If Trim(MyTextB) <> "*" Then
With Worksheets("BT")
 Set rB = .Range("b1:b65536")
End With
Set rFoundB = rB.Resize(1, 1)
Set B = rB.Find(MyTextB, After:=rFoundB, _
  LookIn:=xlValues, _
  Lookat:=xlPart)
If Not B Is Nothing Then
 firstAddress = B.Address
Do
bcopy = False
If (InStr(1, B.Offset(0, 1), Trim(MyTextC), vbTextCompare) > 0 _
    Or Trim(MyTextC) = "*" _
    Or Len(Trim(MyTextC)) = 0) And _
    (InStr(1, B.Offset(0, 2), Trim(MyTextD), vbTextCompare) > 0 _
    Or Trim(MyTextD) = "*" Or Len(Trim(MyTextD)) = 0) Then
   lr = Sheets("Sheet2").Cells(Rows.Count, "a").End(xlUp).Row + 1
    B.EntireRow.Copy Sheets("Sheet2").Rows(lr)
    FoundCount = FoundCount + 1
End If
 
Set B = rB.FindNext(B)
Loop While Not B Is Nothing And B.Address <> firstAddress
End If   ' not B is Nothing
End If
MsgBox FoundCount & " valeurs trouvés", vbInformation, "Transfert complété"
'Sheets("Sheet2").Select
End Sub

merci encore une fois tout le monde !

02/02/2010, 23h48
Duddy

Bonsoir le forum, :D

Moi, j'utilise :

Code:

TonForm.TaTextBox.Value=TonResultat

Bien-sûr, il faut adapter.
03/02/2010, 00h41
p0l1n

vois-tu ce code je ne l'ai pas écrit, et je ne sais pas comment afficher sur plusieurs lignes dans la textbox.

Si il y a 4 mots trouvés, le code copie la ligne et la colle dans la sheet2.
il peut y avoir 2 résultat, comme il peut en avoir 8.

je suis capable afficher 1seul résultat en ajoutant :

Code:

txtresult = B

mais je n'ai qu'une seule ligne et je devrais en avoir 4...

je sais pas si je devrais utiliser la commande offset ?
03/02/2010, 07h18
Qwazerty
Salut
A mon avis, tu ferais bien de remplacer ton TextBox par une zone liste (ListBox) sur ton UserBox et d'utiliser la méthode AddItem du listbox pour ajouter une ligne a chaque fois que tu trouves un résultat à ta recherche, puis au début d'une nouvelle recherche, la methode Clear pour vider ton ListBox
Code:

1 2 3 ListBox.Clear 'vide la zone de liste ListBox1.AddItem = [Cellule ou ce trouve ton résultat].value
Je n'ai pas trop le temps ce matin, si personne ne s'y est penché ou que tu n'as pas trouvé par toi même une solution, je regarderais ce soir.
A++
Qwaz

Salut
En esperant avoir compris ce que tu cherche a faire, je n'ai pas testé faute de fichier adapté.

J'ai commenté ce code pour que tu puisse le comprendre un peu mieux, voici quelques remarques sur le code en lui meme

Les

Code:

Me.

sont inutiles, par defaut vb regarde sur la form en cours

Inutile d'utiliser un with pour une seule ligne de code

Preferer

Code:

range("B:B")

pour selectionner une colonne complete

Lors de l'utilisation de Find, inutile de lui definir After si c'est pour lui mettre la cellule du haut a gauche

Citation:

Envoyé par Aide VBExcel - Find

[...]Si vous ne spécifiez pas cet argument, la recherche commence après la cellule située dans le coin supérieur gauche de la plage.[...]

Plutot que

Code:

Len(Trim(MyTextC)) = 0)

Plus simplement

Code:

trim(MyTextC) = ""

J'ai mis 2 possibilités avec l'utilisation soit d'un textbox soit d'un combobox, si tu ne t'y retrouves pas, n'hésite pas je nettoierais en fonction de ton choix.

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Private Sub CommandButton1_Click()
Dim FoundCount As Double
Dim rFoundB As Range, rFoundC As Range
Dim rFoundD As Range, MyTextB As String
Dim MyTextC As String, MyTextD As String
Dim B As Range, C As Range, D As Range
Dim rB As Range, rC As Range, rD As Range
 
MyTextB = Me.txtfindB.Value 'j'utiliserais Trim ici une bonne fois pour toute MyTextB = Trim(Me.txtfindB.text)
txtresult.MultiLine = True
'On vide le contenu du txt
txtresult.Text = ""
'Si tu utilise un combobox
ComboBox1.Clear
 
'On vide le contenu des cellules de A2 jusqu'à la fin du tableau en colonne F
'Sheets("Sheet2").Range("A2:f65536").ClearContents
Sheets("Sheet2").Range("A2:F" & Rows.Count).ClearContents 'compatible avec Excel 2007 (qui a plus de 65536 lignes)
 
If Trim(MyTextB) <> "*" Then
    'With Worksheets("BT")
    '    Set rB = .Range("b1:b65536")
    'End With
    'Set rB = Worksheets("BT").Range("b1:b65536") 'ou encore mieux si tu veux faire reference a une colonne complete
    Set rB = Worksheets("BT").Range("B:B")
 
    'Set rFoundB = rB.Resize(1, 1) '? 'ca correspond simplement a range("B1")
 
 
    Set B = rB.Find(MyTextB, LookIn:=xlValues, Lookat:=xlPart) 'Set B = rB.Find(MyTextB, After:=rFoundB, LookIn:=xlValues, Lookat:=xlPart)
    If Not B Is Nothing Then
        firstAddress = B.Address
       Do
       bcopy = False '??
       If (InStr(1, B.Offset(0, 1), Trim(MyTextC), vbTextCompare) > 0 _
           Or Trim(MyTextC) = "*" _
           Or Trim(MyTextC) = "") And _
           (InStr(1, B.Offset(0, 2), Trim(MyTextD), vbTextCompare) > 0 _
           Or Trim(MyTextD) = "*" Or Trim(MyTextD) = "") Then
                'ici on renseigne la feuille 2
                lr = Sheets("Sheet2").Cells(Rows.Count, "a").End(xlUp).Row + 1 'attention lr n'est pas declaré? il doit etre déclaré As Long
                B.EntireRow.Copy Sheets("Sheet2").Rows(lr)
                FoundCount = FoundCount + 1
 
                'Je suppose qu'ici tu veux rajouter des entrée dans ton txt
                If txtresult.Text <> "" Then txtresult.Text = txtresult.Text & vbCrLf 'On rajout un retour a la ligne si une entrée est deja presente
                txtresult.Text = txtresult.Text & B.Value
 
                '... j'utiliserais plutot utiliser un ComboBox
                ComboBox1.AddItem B.Value
       End If
 
       Set B = rB.FindNext(B)
       Loop While Not B Is Nothing And B.Address <> firstAddress
    End If   ' not B is Nothing
End If
 
MsgBox FoundCount & " valeurs trouvés", vbInformation, "Transfert complété"
'Sheets("Sheet2").Select
End Sub

En règle général il est bon d'indenter (mettre des tabulations) un code afin de mieux le comprendre et de repérer rapidement les points d'entrée et de sortie des différentes boucles.

A++
Qwaz

J'ai réussi à réglé mon problème et voici comment :

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
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub CommandButton1_Click()
Dim FoundCount As Double
Dim rFoundB As Range
Dim MyTextB As String
Dim B As Range
Dim rB As Range
MyTextB = Me.txtfindB.Value
txtresult.MultiLine = True
Sheets("Sheet2").Range("A2:f65536").ClearContents
 
'**********BBBBBBBBB*********
If Trim(MyTextB) <> "*" Then
With Worksheets("BT")
 Set rB = .Range("b1:b65536")
End With
Set rFoundB = rB.Resize(1, 1)
Set B = rB.Find(MyTextB, After:=rFoundB, _
  LookIn:=xlValues, _
  Lookat:=xlPart)
If Not B Is Nothing Then
 firstAddress = B.Address
 s = ""
Do
bcopy = False
If (InStr(1, B.Offset(0, 1), Trim(MyTextC), vbTextCompare) > 0 _
    Or Trim(MyTextC) = "*" _
    Or Len(Trim(MyTextC)) = 0) And _
    (InStr(1, B.Offset(0, 2), Trim(MyTextD), vbTextCompare) > 0 _
    Or Trim(MyTextD) = "*" Or Len(Trim(MyTextD)) = 0) Then
   lr = Sheets("Sheet2").Cells(Rows.Count, "a").End(xlUp).Row + 1
    B.EntireRow.Copy Sheets("Sheet2").Rows(lr)
    FoundCount = FoundCount + 1
    s = s & Sheets("Sheet2").Cells(lr, "A").Text
    s = s & " - " & Sheets("Sheet2").Cells(lr, "B").Text
    s = s & "  " & Sheets("Sheet2").Cells(lr, "C").Text & " " & vbNewLine
    End If
Set B = rB.FindNext(B)
Loop While Not B Is Nothing And B.Address <> firstAddress
If Len(Trim(s)) > 0 Then
txtresult = s
End If
End If
End If
 
MsgBox FoundCount & " Valeurs trouvés", vbInformation, "Recherche complété"
 
End Sub