Transformer plusieurs lignes en une ligne

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

  • transposer.xlsm
    10.9 KB · Affichages: 28

vgendron

XLDnaute Barbatruc
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
 

job75

XLDnaute Barbatruc
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+
 

Discussions similaires

Réponses
7
Affichages
228

Statistiques des forums

Discussions
311 725
Messages
2 081 949
Membres
101 851
dernier inscrit
vaiata