Concaténer cellules de 3 colonnes de la même ligne dans une autre colonne

Le 19/12/2025 à 12:56

Bonjour à tous

J’ai trouvé un code que j’ai adapté à mes besoins pour concaténer les cellules de la même ligne des colonnes "D", "E" et "F" et les placer dans la colonne "L" à partir de la ligne n° 2, donc : "L2"

Le code fonctionne bien, seulement, je souhaite ajouter une condition à savoir, ne pas concaténer les cellules lorsque la cellule de la colonne "F" est égale à zéro ou vide. Voir texte des cellules concernées en rouge.

J’ai essayé sans succès.

Sauf erreur de ma part, j’ai mis le résultat souhaité en colonne "M".

Merci pour vos retour.

22concatener.xlsm (19.96 Ko)
Le 19/12/2025 à 13:14

Bonjour,

si vous enlevez .value derrière If arr(x, c + 2), ça va mieux.

Sauf que c'est décalé d'une ligne (commence en ligne 2 au lieu de 3), il suffit de mettre L3 au lieu de L2 en bas, et il n'y a rien à côté des lignes où il y a 0, donc il y a des espaces.

Le 19/12/2025 à 13:17

Bonjour,

1 proposition :

Sub JoinCells2()

Dim I As Long, DerniereLigne As Long, LigneEnCours As Long
Dim AireD As Range, AireE As Range, AireF As Range

    DerniereLigne = Cells(Rows.Count, "D").End(xlUp).Row
    LigneEnCours = 2

    Set AireD = Range("D3:D" & DerniereLigne)
    Set AireE = Range("E3:E" & DerniereLigne)
    Set AireF = Range("F3:F" & DerniereLigne)

    For I = 1 To AireD.Count
        If AireF(I) > 0 Then
           Cells(LigneEnCours, "L") = "Classe " & AireD(I) & " " & AireF(I) & " Oiseaux Juges Expert : " & AireE(I)
           LigneEnCours = LigneEnCours + 1
        End If
    Next I

    Set AireD = Nothing: Set AireE = Nothing: Set AireF = Nothing

End Sub
Le 19/12/2025 à 13:33

Bonjour tout le monde

Le fichier modifié en retour

13concatener.xlsm (23.26 Ko)
Le 19/12/2025 à 13:46

Bonjour Doux Rêveur,

Merci pour votre retour.

J’avais déjà tester mon code en enlèvant le (.Value) et j’ai remarqué les lignes vides, malheureusement, j’ai besoin du résultat dans la colonne "L" sans ligne vide pour une utilisation ultérieure.

Merci en tout cas pour votre intervention.

Maintenant je vais tester le code de Eric Kergresse.

Bien à vous.

Le 19/12/2025 à 14:11

Bonjour à tous,

Une variante.....à tester....

Sub test()
 Dim tb, ntb(), x%, i%
  With Sheets("L_Juges")
   .Columns("L:L").ClearContents
    tb = .Range("D2:F" & .Range("D" & Rows.Count).End(xlUp).Row)
    x = 1
     For i = 1 To UBound(tb, 1)
      If tb(i, 3) > 0 Then
       ReDim Preserve ntb(1 To 1, 1 To x + 1)
        ntb(1, x) = "Classe " & tb(i, 1) & " " & tb(i, 3) & " Oiseaux " & " " & "Juges Expert : " & tb(i, 2): x = x + 1
      End If
     Next i
    If x > 0 Then .Range("L2").Resize(x, 1) = Application.Transpose(ntb)
  End With
 Erase tb: Erase ntb
End Sub
11harzer-concatener.xlsm (18.69 Ko)

Cordialement,

Le 19/12/2025 à 15:51

Bonjour Eric Kergresse,

Merci pour votre retour et le code proposé, ce dernier me donne le bon résultat, sans lignes vides.

Comme mon nombre de lignes est assez conséquent, 100.000 lignes, le temps d’exécution est un peu lent.

Merci beaucoup.

Salutations.

Le 19/12/2025 à 16:10

Bonjour Joco7915,

Merci pour votre retour.

J’ai testé le code, le seul problème est que j’ai des lignes vides lorsqu’on traite les cellules de la colonne "F" qui sont égale à zéro.

Merci pour votre proposition.

Maintenant, je vais tester le code de xorsankukai pour lui répondre par la suite.

Salutations.

Le 19/12/2025 à 16:23

Le code ci-dessous neutralise l'écran et le calcul, regardez si cela améliore la durée :

Sub JoinCells2()

Dim I As Long, DerniereLigne As Long, LigneEnCours As Long
Dim AireD As Range, AireE As Range, AireF As Range

    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With

    DerniereLigne = Cells(Rows.Count, "D").End(xlUp).Row
    LigneEnCours = 2

    Set AireD = Range("D3:D" & DerniereLigne)
    Set AireE = Range("E3:E" & DerniereLigne)
    Set AireF = Range("F3:F" & DerniereLigne)

    For I = 1 To AireD.Count
        If AireF(I) > 0 Then
           Cells(LigneEnCours, "L") = "Classe " & AireD(I) & " " & AireF(I) & " Oiseaux Juges Expert : " & AireE(I)
           LigneEnCours = LigneEnCours + 1
        End If
    Next I

    Set AireD = Nothing: Set AireE = Nothing: Set AireF = Nothing

    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With

End Sub
Le 19/12/2025 à 17:06

Bonjour xorsankukai,

Merci pour votre retour et le code proposé.

Pour vous permettre à trouver une solution à mon problème, j’ai fait un petit fichier pour l’exercice, ce dernier contient très peu données.

Mon fichier réel contient plus de 100.000 lignes.

En testant le code, j’étais obligé de déclarer les variables x et i en long au lieu d’integer, sinon j’avais dépassement de capacité.

Le code s’exécute très rapidement (probablement suite à l’utilisation des tableaux = rapidité), lorsqu’il arrive à la ligne L35329, il me met le caractère "N/A" à toute les lignes suivantes.

Je me demande si ce n’est pas le fait d’avoir utilisé la fonction "Transpose", je ne suis pas sûr de mes propos mais je me demande si cette fonction n’est pas limitée à 35329.

À vous lire.

Le 19/12/2025 à 17:24

Bonjour Eric Kergresse,

Merci pour votre retour et l’ajoute de :

.ScreenUpdating = False

.Calculation = xlCalculationManual pour améliorer l’exécution du code.

Cela n’a malheureusement pas apporté un mieux mais j’apprécie le fait que vous m’avez répondu une 2e fois.

Cela dit, à défaut que je ne trouve pas une solution plus rapide, je suis très satisfait de votre proposition que je la mettrais en application dans mon projet.

Merci encore et au plaisir de vous lire à l’occasion.

Le 19/12/2025 à 17:33

Quelle est la proportion de valeurs 0 dans l'ensemble ? Autrement dit, au terme du calcul, combien récupérez-vous de lignes sur les 100 000 ?

Si ce nombre est important, le tri préalable selon la colonne F permettrait de ne traiter que les valeurs supérieures à 0.

Le 19/12/2025 à 17:52

Re,

En testant le code, j’étais obligé de déclarer les variables x et i en long au lieu d’integer, sinon j’avais dépassement de capacité.

Effectivement, il faut déclarer les variables de ligne en Long.

Le code s’exécute très rapidement (probablement suite à l’utilisation des tableaux = rapidité), lorsqu’il arrive à la ligne L35329, il me met le caractère "N/A" à toute les lignes suivantes.

Oui, il y a bien une limite, j'avais déjà été confronté à ce problème.

Un essai sans transpose....

Sub test()
 Dim tb, ntb(), x&, i&
  With Sheets("L_Juges")
   .Columns("L:L").ClearContents
    tb = .Range("D2:F" & .Range("D" & Rows.Count).End(xlUp).Row)
    x = 0
    ReDim ntb(0 To UBound(tb, 1), 1 To 1)
     For i = 1 To UBound(tb, 1)
      If tb(i, 3) > 0 Then
        ntb(x, 1) = "Classe " & tb(i, 1) & " " & tb(i, 3) & " Oiseaux " & " " & "Juges Expert : " & tb(i, 2): x = x + 1
      End If
     Next i
    If x > 0 Then .Range("L2").Resize(x, 1) = ntb
  End With
 Erase tb: Erase ntb
End Sub
11harzer-concatener-sans-transpose.xlsm (20.05 Ko)

Cordialement,

Le 19/12/2025 à 18:47

Une solution en triant la colonne F et en faisant partir le programme après les lignes avec valeur 0

Option Explicit

Sub JoinCells3()

Dim I As Long, DerniereLigne As Long, LigneEnCours As Long, DerniereLigne0 As Long
Dim AireD As Range, AireE As Range, AireF As Range
Dim HeureDebut, HeureFin, TempsTotal

    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With

    HeureDebut = Timer
    DerniereLigne = Cells(Rows.Count, "D").End(xlUp).Row

    Set AireD = Range("D3:D" & DerniereLigne)
    Set AireE = Range("E3:E" & DerniereLigne)
    Set AireF = Range("F3:F" & DerniereLigne)

    TriDescendant Range(AireD, AireF), 3
    DerniereLigne0 = WorksheetFunction.Match(0, AireF, -1)

    LigneEnCours = 2
    DerniereLigne = Cells(Rows.Count, "L").End(xlUp).Row
    Range(Cells(LigneEnCours, "L"), Cells(DerniereLigne, "L")).ClearContents

    For I = 1 To DerniereLigne0 + 1 'AireD.Count
        If AireF(I) > 0 Then
           Cells(LigneEnCours, "L") = "Classe " & AireD(I) & " " & AireF(I) & " Oiseaux Juges Expert : " & AireE(I)
           LigneEnCours = LigneEnCours + 1
        End If
    Next I

    Set AireD = Nothing: Set AireE = Nothing: Set AireF = Nothing

    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
    HeureFin = Timer
    TempsTotal = HeureFin - HeureDebut
    MsgBox "Temps total du traitement : " & Round(TempsTotal, 0) & " secondes"

End Sub

Sub TriDescendant(ByVal AireATrier As Range, ByVal ColonneDuTri As Integer)

    With AireATrier.Parent
         .Sort.SortFields.Clear
         .Sort.SortFields.Add2 Key:=AireATrier.Columns(ColonneDuTri), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
         With .Sort
              .SetRange AireATrier
              .Header = xlNo
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
        End With
    End With

End Sub
Le 19/12/2025 à 20:43

Avec une solution Power Query.

Si vous ne connaissez pas Power Query, copiez collez votre tableau de 100 000 lignes dans mon fichier et actualisez.

let
    Source = Excel.CurrentWorkbook(){[Name="Tableau1"]}[Content],
    #"Type modifié" = Table.TransformColumnTypes(Source,{{"Colonne1", type text}, {"Colonne2", type text}, {"Colonne3", Int64.Type}}),
    #"Lignes filtrées" = Table.SelectRows(#"Type modifié", each ([Colonne3] <> 0)),
    #"Type modifié1" = Table.TransformColumnTypes(#"Lignes filtrées",{{"Colonne3", type text}}),
    #"Personnalisée ajoutée" = Table.AddColumn(#"Type modifié1", "Concaténation", each "Classe "&[Colonne1]&" "&[Colonne3]&" Oiseaux Juges Expert : "&[Colonne2]),
    #"Autres colonnes supprimées" = Table.SelectColumns(#"Personnalisée ajoutée",{"Concaténation"})
in
    #"Autres colonnes supprimées"
capture
8concatener-ek.xlsm (32.48 Ko)
Le 19/12/2025 à 21:00

Bonsoir à tous !

Une autre approche Power Query ?

let
    Source = Excel.CurrentWorkbook(){[Name = "tSource"]}[Content], 
    Traitt = List.Transform(
        Table.ToRows(Table.SelectRows(Source, each [Colonne3] > 0)), 
        each "Classe " & _{0} & " " & Text.From(_{2}) & " Oiseaux Juges Expert : " & _{1}
    )
in
    Traitt

Cette requête est basée sur un tableau structuré nommé "tSource".

Le 19/12/2025 à 21:20
Sub JoinCells()
     Dim Arr, ArrResult, L As Long, Cnt As Long, t

     t = Timer
     With Sheets("L_Juges")
          .Columns("D").Name = "D_"
          L = Evaluate("max(if(len(D_),row(D_),0))")
          If L = 0 Then MsgBox "vide": Exit Sub
          Arr = .Range("D3:F" & L).Value2
          ReDim ArrResult(1 To L, 0)

          For L = 1 To UBound(Arr, 1)
               If Val(Arr(L, 3)) > 0 Then
                    Cnt = Cnt + 1
                    ArrResult(Cnt, 0) = "Classe " & Arr(L, 1) & " " & Arr(L, 3) & " Oiseaux " & "Juges Expert : " & Arr(L, 2)
               End If
          Next

          Application.ScreenUpdating = False
          With .Range("L2")
               .Resize(Rows.Count - .Row + 1).ClearContents
               .Resize(Cnt).Value = ArrResult
               .EntireColumn.AutoFit
          End With
     End With
     MsgBox Timer - t
End Sub
Le 20/12/2025 à 20:25

Bonjour à tous les intervenants,

Eric Kergresse, xorsankukai, JFL et BsAlv, j’espère que je n’ai oublié personne.

Je vous réponds un jour en retard car j’étais en déplacement.

Pour commencer, mille merci à tous pour vos codes respectifs.

Merci également pour votre disponibilité, je suis plus que satisfait car les solutions proposées sont de qualité.

J’ai même des difficultés pour choisir une solution parmi ce qui a été proposé, c’est même dommage qu’il faut en choisir une pour indiquer que le problème est résolu.

Bon Noël et bonne fête de fin d'année.

Cordiale poignée à tous.

Le 21/12/2025 à 10:55

Bonjour à tous !

Je vous remercie de ce fort sympathique retour.

Rechercher des sujets similaires à "concatener colonnes meme ligne colonne"