Hello,

Je n'arrive pas à modifier cette macro pour qu'elle puisse lister du texte concaténer

En résumé, j'aimerai lister le texte de la colonne "A" qui contient du texte concaténé et au clic dans la listbox, sélectionner la ligne de la feuille contenant le texte

Merci pour votre aide et bon weekend
Philippe

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
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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Option Explicit
Dim f, choix(), Rng, Ncol
Dim n As Variant
Dim k As Variant
Private Sub UserForm_Initialize()
Dim DerniereLigne As Long
Dim c As Variant
Dim tmp As Variant
Dim TblTmp()
On Error GoTo FichierVide
    Set f = ActiveSheet
    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData 'Enlever les filtres
    DerniereLigne = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Set Rng = Range(Cells(25, 1), Cells(DerniereLigne, 1))
    n = 0
    For Each c In Rng.SpecialCells(xlCellTypeConstants, 23)
        n = n + 1
        ReDim Preserve TblTmp(1 To 2, 1 To n)
        TblTmp(1, n) = c.Address
        On Error Resume Next
        tmp = Replace(Replace(c.Value, Chr(13), "  -  "), Chr(10), "")
        tmp = c.Value
        On Error GoTo 0
        TblTmp(2, n) = tmp
        ReDim Preserve choix(1 To n)
        choix(n) = choix(n) & TblTmp(1, n) & " * " & TblTmp(2, n)
    Next c
    Ncol = 2
    Me.ListBox1.List = Application.Transpose(TblTmp)
    Me.TextBox1.SetFocus 'Place le curseur dans la textbox
    Me.Label_Nombre_trouve.Caption = "Trouvé : " & n + 1
FichierVide:
End Sub
Private Sub TextBox1_Change()
Dim Mots As Variant
Dim Tbl As Variant
Dim i As Variant
Dim a As Variant
   On Error Resume Next 'Evite le beug lorsque l'on saisi un espace pour commencer
   If Me.TextBox1 <> "" Then
        Mots = Split(Trim(Me.TextBox1), " ")
        Tbl = choix
        For i = LBound(Mots) To UBound(Mots)
            Tbl = Filter(Tbl, Mots(i), True, vbTextCompare)
        Next i
        If UBound(Tbl) > -1 Then
                n = 0: Dim b()
            For i = LBound(Tbl) To UBound(Tbl)
                a = Split(Tbl(i), "*")
                n = n + 1: ReDim Preserve b(1 To Ncol, 1 To n)
                For k = 1 To Ncol
                    b(k, i + 1) = a(k - 1)
                Next k
            Next i
            If n > 0 Then
                ReDim Preserve b(1 To Ncol, 1 To n + 1)
                Me.ListBox1.List = Application.Transpose(b)
                Me.ListBox1.RemoveItem n
            End If
        Else
            Me.ListBox1.Clear
        End If
        Me.Label_Nombre_trouve.Caption = "Trouvé : " & UBound(Tbl) + 1
    Else
        UserForm_Initialize
    End If
End Sub
Private Sub ListBox1_Click()
Dim adr As Variant
Dim Ligne As Long
    For k = 0 To Ncol - 1
      Me("TextBox" & k + 2) = Me.ListBox1.Column(k)
    Next k
    adr = Me.ListBox1
    Ligne = Range(adr).Row 'Déplace le document pour rendre visible l'étiquette
    Rows(Ligne).Select 'Déplace le document pour rendre visible l'étiquette
 
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub