Concatener dans une même cellule tous résultats rechercheH

Résolu/Fermé
thyroox Messages postés 34 Date d'inscription jeudi 27 juillet 2017 Statut Membre Dernière intervention 25 février 2022 - 24 févr. 2022 à 18:01
thyroox Messages postés 34 Date d'inscription jeudi 27 juillet 2017 Statut Membre Dernière intervention 25 février 2022 - 25 févr. 2022 à 18:57
Bonjour,


Je souhaite concaténer dans une même cellule tous les résultats d'une rechercheH.
J'y arrive avec =JOINDRE.TEXTE() cependant mon fichier présente plus de 250 000 lignes.

J'aimerai donc un code en VBA pour arriver au résultat ci-dessous pour les cellules de la colonne C :





Pourriez-vous m'aidez s'il vous plait ?

Vous remerciant par avance.
A voir également:

2 réponses

cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
Modifié le 25 févr. 2022 à 08:59
Bonjour,

comme ceci d'après l'image:

Option Explicit
Sub concatener()
Dim k As Long
Dim i As Long
Dim j As Long
 
    For i = 2 To Range("D" & Rows.Count).End(xlUp).Row
        If Len(Cells(i, 4)) > 1 Then
        Cells(i, 3) = Cells(i, 4) & "; "
        End If
           Next i
        For j = 2 To Range("E" & Rows.Count).End(xlUp).Row
     If Len(Cells(j, 5)) > 1 Then
        Cells(j, 3) = Cells(j, 3) & Cells(j, 5) & "; "
         End If
           Next j
      For k = 2 To Range("F" & Rows.Count).End(xlUp).Row
     If Len(Cells(k, 6)) > 1 Then
        Cells(k, 3) = Cells(k, 3) & Cells(k, 6)
          End If
           Next k
         ActiveSheet.Columns("C:C").AutoFit
 End Sub




0
thyroox Messages postés 34 Date d'inscription jeudi 27 juillet 2017 Statut Membre Dernière intervention 25 février 2022 1
Modifié le 25 févr. 2022 à 18:26
Bonjour @cs_Le Pivert,


Dans un premier je vous remercie pour votre réponse.
J'ai essayé le code cependant en l'état il ne fonctionne pas. J'ai donc du mettre >=1 et cela rempli les cellules de la colonne C avec des "X".

Mon besoin était de rapatrier les adresses mails de la ligne 1 en fonction des "X".

J'ai essayé de modifier le code mais je n'y suis pas arrivé.

Voyez vous comment faire ?


Merci d'avance.
0
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
25 févr. 2022 à 18:43
voici la correction:

Option Explicit
Sub concatener()
Dim k As Long
Dim i As Long
Dim j As Long
    
    For i = 2 To Range("D" & Rows.Count).End(xlUp).Row
        If Cells(i, 4) = "x" Then
        Cells(i, 3) = Cells(1, 4) & "; "
        End If
           Next i
        For j = 2 To Range("E" & Rows.Count).End(xlUp).Row
     If Cells(j, 5) = "x" Then
        Cells(j, 3) = Cells(j, 3) & Cells(1, 5) & "; "
         End If
           Next j
      For k = 2 To Range("F" & Rows.Count).End(xlUp).Row
     If Cells(k, 6) = "x" Then
        Cells(k, 3) = Cells(k, 3) & Cells(1, 6)
          End If
           Next k
         ActiveSheet.Columns("C:C").AutoFit
 End Sub
Sub test() 'supprime les derniers point virgule
Dim i As Long
Dim fin As String
For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
fin = Right(Cells(i, 3), 2)
If fin = "; " Then
Cells(i, 3) = Left(Cells(i, 3), Len(Cells(i, 3)) - 2)
End If
Next i
End Sub


j'ai mis un x minuscule, si cela ne fonctionne pas mettre un X majuscule
0
thyroox Messages postés 34 Date d'inscription jeudi 27 juillet 2017 Statut Membre Dernière intervention 25 février 2022 1
25 févr. 2022 à 18:57
@cs_Le Pivert


Merci beaucoup, cela fonctionne. J'ai du mettre x en majuscule mais c'est impeccable. Merci pour votre aide.
0