Listbox et formule

Version imprimable

Listbox et formule

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:

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

07/12/2019, 18h11
Pierre Fauconnier

Salut Philippe ;)

Qu'appelles-tu du texte concaténé? Peux-tu donner une copie d'écran en mettant par exemple en couleur les cellules que tu considères comme contaténées?
07/12/2019, 18h45
goninph

1 pièce(s) jointe(s)

Salut Pierre

Pièce jointe 522583

Tu as besoin d'une fonction qui sélectionne les cellules d'une plage contenant une formule ET le signe de concaténation &. Cette fonction, placée dans un module standard, renverra un tableau de deux lignes et d'autant de colonnes qu'il y a de cellules concernées dans la plage. Dans la première ligne de chaque colonne du tableau, on placera le numéro de la ligne de la cellule, et dans la seconde ligne, on placera la valeur trouvée dans la cellule.

Note, au passage, qu'il s'agit ici de récupérer les cellules dont la formule utilise l'opérateur de concaténation & . Les formules utilisant une fonction de concaténation ne sont pas prises en compte, mais tu as compris le principe. Il suffira d'adapter le test sur la formule pour détecter qu'une fonction de concaténation a été utilisée.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Function getValues(r As Range) Dim c As Range ReDim t(1 To 2, 1 To 1) Dim Index As Long For Each c In r If c.HasFormula And InStr(1, c.Formula, "&") > 0 Then Index = UBound(t, 2) If Not IsEmpty(t(1, 1)) Then Index = Index + 1 ReDim Preserve t(1 To 2, 1 To Index) End If t(1, Index) = c.Row t(2, Index) = c.Value End If Next c getValues = t End Function
Toujours dans le module standard, tu as besoin du code qui chargera le userform, le préparera et l'affichera. La même procédure récupérera le numéro de la ligne choisie, à savoir la valeur du listbox du userform. Comme le tableau renvoyé par GetValues est permuté (les lignes et colonnes du tableau deviennent respectivement les colonnes et lignes du listbox), on utilise la propriété Column du listbox et non sa propriété List.
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub Test() Dim Values Values = getValues(Range("a1:a50")) With UserForm1 .lboValues.Column = Values .Show If Not IsNull(.lboValues.Value) Then Cells(.lboValues.Value, 1).Select End With Unload UserForm1 End Sub
Dans le userform, on place un listbox contenant deux colonnes, la première masquée contenant le numéro de lignes, la seconde la valeur de la cellule. Le code de mon exemple est très simple, un click sur le listbox le ferme et rend la main au code appelant.
Code:

1 2 3 Private Sub lboValues_Click() Me.Hide End Sub
Ce code est évidemment à adapter à ton cas.

27/12/2019, 15h43
goninph

Hello,

Avec un peu de retard, merci l'aide apportée.

Tous mes vœux pour a nouvelle année