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
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
A voir également:
- Concatener dans une même cellule tous résultats rechercheH
- Aller à la ligne dans une cellule excel - Guide
- Lexer resultats - Télécharger - Sport
- Concatener deux cellules excel - Guide
- Excel cellule couleur si condition texte - Guide
- Verrouiller une cellule excel - Guide
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
Modifié le 25 févr. 2022 à 08:59
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
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
25 févr. 2022 à 18:43
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
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
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.
Merci beaucoup, cela fonctionne. J'ai du mettre x en majuscule mais c'est impeccable. Merci pour votre aide.
Modifié le 25 févr. 2022 à 18:26
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.