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

Question

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.

cs_Le Pivert · Answer

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

cs_Le Pivert · Answer

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

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

2 réponses

Discussions similaires

Newsletters