Transposer automatiquement des colonnes en lignes

[Amstrad]

Bonsoir,

Le fichier ci-joint contient des données dans une seule colonne sous cette forme :

A
A1
A2
A3
B
B1
B2
B3
B4
C
C1
C2

J'aimerais faire une transposition en ligne afin d'avoir un resultat similaire à ca :
A A1 A2 A3
B B1 B2 B3 B4
C C1 C2

La difficulté est que pour chaque "section", le nombre de lignes différe.
(cf fichier ci-joint : le serveur100 dispose de 9 lignes, le serveur3k comprend 6 lignes etc)

Avez vous une idée afin que je puisse regler ce souci svp ? (mon fichier source comprend en tout 3000 lignes, vous comprendrez que j'aimerais eviter de faire la manipulation à la main )

Merci

 

[Staple1600]

Re : Transposer automatiquement des colonnes en lignes

Bonsoir à tous

Amstrad
En attendant les "Docteurs es Arrays" du forum
Voici un code à tester

Sub Essai()
'adapté d'un code de jindon
Dim r As Range
Dim i As Long, rng() As Range, x$
With Sheets(1)
    Application.ScreenUpdating = False
    Set r = .Columns(2).Find(What:="Name*", After:=.Cells(65536, 2), _
            LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If Not r Is Nothing Then
        x = r.Address
        Do
            i = i + 1: ReDim Preserve rng(1 To i)
            Set rng(i) = r
            Set r = .Columns(2).Find(What:="Name*", After:=r, _
            LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        Loop Until r.Address = x
        i = i + 1: ReDim Preserve rng(1 To i)
        Set rng(i) = .Cells(Rows.Count, 2).End(xlUp).Offset(1)
        For i = LBound(rng) To UBound(rng) - 1
            .Range(rng(i), rng(i + 1).Offset(-1)).Copy
            rng(i).Offset(, 1).PasteSpecial Transpose:=True
        Next
    End If
    .Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    .Columns("A:B").Delete Shift:=xlToLeft
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End With
End Sub

PS: test OK sur mon PC avec le fichier joint
(donc la macro est écrite pour fonctionner avec des données en colonne B)

 

[hassan.zer]

Re : Transposer automatiquement des colonnes en lignes

Bonsoir,

Est-ce cela que vous voulez ?

 

[amstrad07]

Re : Transposer automatiquement des colonnes en lignes

Bonsoir,

Est-ce cela que vous voulez ?

Oui Hassen, c'est ca.

Merci Staple, je vais tester

 

[Staple1600]

Re : Transposer automatiquement des colonnes en lignes

Re

Amstrad
Pourquoi avoir changer de pseudo ??

 

[amstrad07]

Re : Transposer automatiquement des colonnes en lignes

Re

Amstrad
Pourquoi avoir changer de pseudo ??

impossible de me relogguer avec mon autre pseudo.
avant de poster mon message initial, j'avais sollicité un rappel du mdp par email..avant de tester un mot de passe avec succes.
j'ai l'impression que maintenant le nouveau mot de passe a été pris en compte sauf que je ne l'ai tjs pas recu par mail (soit lenteur du site, soit lenteur de ma messagerie yahoo)..

desolé si ce n'est pas clair.

 

[Staple1600]

Re : Transposer automatiquement des colonnes en lignes

Re

Amstrad
Tu as testé le code VBA au moins ?

 

[amstrad07]

Re : Transposer automatiquement des colonnes en lignes

Super Staple!! ca m'enleve une sacrée epine du pied. Ca me donne encore plus envie de m'investir dans le vba.
tu disais tout à l'heure "en attendant les docteurs arrays" : au final, qu'est cela aurait pu m'apporter en plus ?

Merci

 

[Staple1600]

Re : Transposer automatiquement des colonnes en lignes

Re

au final, qu'est cela aurait pu m'apporter en plus ?

Un code plus concis et plus rapide
Je me mettrais dans l'Array durant ce week-end et te proposerai un code les utilisant
(avec sans doute du Dictionary pour relever le gout)
Mais peut-être que d'ici là les arraytophiles du forum seront passés ici

En attendant, un dernier code pour la route
(histoire de varier les plaisirs)

Sub EssaiII()
'adapté d'un code d'Armando Montes
'oui je sais ce soir je me foule pas des masses ;-)
Dim Dlig&, x
Application.ScreenUpdating = False
Dlig = Range("B" & Rows.Count).End(xlUp).Row
For i = Dlig To 2 Step -1
   With Range("B" & i)
       If .Value Like "Name*" Then Rows(i).Insert
   End With
Next i
For Each x In Columns("B").SpecialCells(2).Areas
   x(1).Offset(, 1).Resize(, x.Rows.Count).Value = _
   Application.Transpose(x)
Next x
Columns("C").SpecialCells(4).EntireRow.Delete: Columns("A:B").Delete
Application.ScreenUpdating = True
End Sub

 

[ROGER2327]

Re : Transposer automatiquement des colonnes en lignes

Bonjour à tous.

Une autre proposition dans le classeur joint.
Rapide. Testée de zéro à cinq-cent mille lignes.
Ne détruit pas les données.​

Bonne journée.


ℝOGER2327
#7661

Jeudi 5 As 142 (Saint Van Meegeren, faussaire - fête Suprême Quarte)
17 Brumaire An CCXXIII, 0,8996h - cresson
2014-W45-5T02:09:32Z

 

[ROGER2327]

Re : Transposer automatiquement des colonnes en lignes

Suite...

Test de rapidité.

512 024 lignes de données dont 59 392 commençant par Name: .

1. Procédure Essai corrigée parce qu'en 2014 Excel97 a vécu et que .Cells(65536, 2) est plus qu'obsolète.
   .Cells(.Rows.Count, 2) devrait satisfaire tout le monde.
   Durée d'exécution : ~1 h 15 min.
   Données détruites.
   
   
2. Procédure EssaiII corrigée en déclarant toutes les variables.
   Durée d'exécution : ~1 h 3 min.
   Données détruites.
   
   
3. Procédure ToTo.
   Durée d'exécution : ~3,6 s dont ~0,9 s pour le calcul et 2,7 s pour l'affichage (Merci, Bill !).
   Données préservées.

No comment.
​

Bonne journée.


ℝOGER2327
#7662

Jeudi 5 As 142 (Saint Van Meegeren, faussaire - fête Suprême Quarte)
17 Brumaire An CCXXIII, 5,6381h - cresson
2014-W45-5T13:31:53Z

 

[klin89]

Re : Transposer automatiquement des colonnes en lignes

Bonsoir à tous,

Si vous voulez tester !
Détruit les données.

Sub Transpose()
Dim Rng As Areas, i As Long
    Application.ScreenUpdating = False
    With Range("a1", Range("a" & Rows.Count).End(xlUp)).Offset(, 1)
        .Formula = "=if(EstGras(a1),1,"""")"
        .Value = .Value
        On Error Resume Next
        .SpecialCells(2, 1).EntireRow.Insert
        .EntireColumn.Delete
    End With
    Set Rng = Columns(1).SpecialCells(2).Areas
    On Error GoTo 0
    If Rng Is Nothing Then Exit Sub
    For i = 1 To Rng.Count
        Rng(i).Copy
        Cells(i, 3).PasteSpecial Transpose:=True
    Next
    Columns.AutoFit
    Columns("A:B").Delete
    Application.ScreenUpdating = True
End Sub


Function EstGras(r As Range) As Boolean
    EstGras = r.Font.Bold = True
End Function

Klin89

 

[ROGER2327]

Re : Transposer automatiquement des colonnes en lignes

Re...

(...)
Si vous voulez tester !
(...)

Pourquoi pas ? Résultat sur les mêmes données que dit plus haut : trois bons quarts d'heure...​

Bonne nuit.


ℝOGER2327
#7669

Dimanche 8 As 142 (Saint Rimbe, Oisif - fête Suprême Tierce)
20 Brumaire An CCXXIII, 8,0988h - herse
2014-W46-1T19:26:14Z