Concatener dans une même cellule tous résultats rechercheH
Résolu
thyroox
Messages postés
34
Date d'inscription
Statut
Membre
Dernière intervention
-
thyroox Messages postés 34 Date d'inscription Statut Membre Dernière intervention -
thyroox Messages postés 34 Date d'inscription Statut Membre Dernière intervention -
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.
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:
- Concatener dans une même cellule tous résultats rechercheH
- Resultats foot - Télécharger - Vie quotidienne
- Concatener deux cellules excel - Guide
- Aller à la ligne dans une cellule excel - Guide
- Excel cellule couleur si condition texte - Guide
- Proteger cellule excel - Guide
2 réponses
Bonjour,
comme ceci d'après l'image:
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
voici la correction:
j'ai mis un x minuscule, si cela ne fonctionne pas mettre un X majuscule
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
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.