Transformer plusieurs lignes en une ligne

  • Initiateur de la discussion Initiateur de la discussion maval
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

maval

XLDnaute Barbatruc
Bonjour

J’ai dans mon fichier des valeurs « F » qui commence toutes par <polygon et ces valeurs sont sur plusieurs lignes j’aimerais les transformer sur une ligne, j’ai fait un modèle pour être plus explicite

je vous remercie
Max
 

Pièces jointes

Re

un essai ici
VB:
Sub rassemble()
Dim TabIni() As Variant
With ActiveSheet
    Fin = .Range("G" & .Rows.Count).End(xlUp).Row
    TabIni = .Range("F5:G" & Fin).Value
    TailleFinale = WorksheetFunction.CountA(.Range("F5:F" & Fin))
    ReDim TabFinal(1 To TailleFinale, 1 To 1)
End With
k = 1
For i = LBound(TabIni, 1) To UBound(TabIni, 1)
    If TabIni(i, 1) <> "" Then
        TabFinal(k, 1) = TabIni(i, 1)
       
        j = i
       
        While TabIni(j + 1, 1) = "" And j <= Fin - 5
            TabFinal(k, 1) = TabFinal(k, 1) & "," & TabIni(j + 1, 2)
            j = j + 1
            If j = Fin - 4 Then GoTo recopie
        Wend
        k = k + 1
    End If
Next i
recopie:
With Sheets("Feuil2")
    .Range("A1").Resize(UBound(TabFinal, 1), UBound(TabFinal, 2)) = TabFinal
    .Range("B:B").Clear
End With
End Sub
 
Bonsoir maval, vgendron,
Code:
Sub Concatener()
Dim tablo, resu(), i&, n&
With [F5].CurrentRegion
    tablo = .Resize(, 2)
    ReDim resu(1 To UBound(tablo), 1 To 1)
    For i = 1 To UBound(tablo)
        If tablo(i, 1) <> "" Then n = n + 1: resu(n, 1) = tablo(i, 1)
        If n Then resu(n, 1) = resu(n, 1) & tablo(i, 2)
    Next
    Application.ScreenUpdating = False
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    .ClearContents 'RAZ
    If n Then .Resize(n, 1) = resu 'restitution
    With .Parent.UsedRange: End With 'actualise les barres de défilement
End With
End Sub
A+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2021 Macro
Réponses
6
Affichages
234
Réponses
2
Affichages
148
  • Question Question
Microsoft 365 problème d'index
Réponses
19
Affichages
375
Retour