Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Listbox et formule


Sujet :

Macros et VBA Excel

  1. #1
    Membre régulier
    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 :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

  2. #2
    Responsable
    Office & Excel

    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?
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Une fois pour toutes, je donne mon avis. Je ne vais pas le répéter à chaque message...
    Si je propose une solution générique sur votre solution spécifique, c'est parce que, fainéant de nature, je privilégie le réutilisable...
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  3. #3
    Membre régulier
    Salut Pierre


  4. #4
    Responsable
    Office & Excel

    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.
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Une fois pour toutes, je donne mon avis. Je ne vais pas le répéter à chaque message...
    Si je propose une solution générique sur votre solution spécifique, c'est parce que, fainéant de nature, je privilégie le réutilisable...
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  5. #5
    Membre régulier
    Hello,

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

    Tous mes vœux pour a nouvelle année

###raw>template_hook.ano_emploi###