Discussion :

[goninph]

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

[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?

[goninph]

Salut Pierre

[Pierre Fauconnier]

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 :

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
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 :

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

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 :

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

1
2
3
Private Sub lboValues_Click()
  Me.Hide
End Sub

Ce code est évidemment à adapter à ton cas.

[goninph]

Hello,

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

Tous mes vœux pour a nouvelle année