Transposer ligne en colonne sous conditions

Bonjour,

Je souhaite transformer des lignes en colonnes sous conditions. En effet, dans le tableau initial chaque fois que chemin est trouvé (cf exemple joint) , une nouvelle ligne est créée en recopiant les les cellules de colonne A à colonne C. Les cellules de la colonne A au-dessous de la cellule intitulée chemin sont à affecter dans autant de colonnes que de lignes existantes. Et lorsque chemin est à nouveau trouvé, on répète l'opération précédente.

Dans l'exemple joint, au-dessus de chaque cellule intitulée chemin se trouve une ligne vide.

J'ai essayé une boucle en vain.

J'ai conscience qu'un exemple sera plus parlant.

Merci de votre retour

Bien cordialement

Bonjour,

Dans une transposition les lignes deviennent colonnes et les colonnes lignes !

Mais ce n'est pas ce qui apparaît dans ton exemple :

La première ligne du bloc (Chemin) est conservée en ligne et s'ajoute sur la même ligne le reste de la col. A du bloc qui lui est transposé, mais uniquement cette colonne, la colonne C disparaît !

Doit-elle disparaître ?

Bonjour,

Tout d'abord merci de votre retour.

Effectivement la ligne du bloc chemin est conservée en ligne : c'est la seule qui reprend les informations des 3 colonnes (A,B,C) et ce pour chaque bloc chemin.

Ensuite seules les valeurs en ligne de la colonne A sous chaque bloc chemin sont conservées autant de colonnes à créer que de lignes sous chemin.

Les valeurs des colonnes B & C ne sont pas reprises et doivent disparaître.

Bien cordialement

Re,

Sub Chemins()
    Dim Ch(), orig, i&, n&, j%, k%
    With ActiveSheet
        i = .Cells(.Rows.Count, 1).End(xlUp).Row
        orig = .Range("A3:C" & i).Value
    End With
    For i = 1 To UBound(orig)
        If orig(i, 1) = "" Then
            k = IIf(k < i - n, i - n, k): n = i
        End If
    Next i
    If i - n > k Then k = i - n: n = 0
    For i = 1 To UBound(orig)
        If orig(i, 1) = "Chemin" Then
            ReDim Preserve Ch(k, n)
            For j = 0 To 2
                Ch(j, n) = orig(i, j + 1)
            Next j
        ElseIf orig(i, 1) <> "" Then
            Ch(j, n) = orig(i, 1): j = j + 1
        Else
            n = n + 1
        End If
    Next i
    Application.ScreenUpdating = False
    With Worksheets.Add(after:=ActiveSheet)
        .Range("A1").Resize(n + 1, k + 1).Value = WorksheetFunction.Transpose(Ch)
    End With
End Sub

Nb- On prélève les données en tableau pour aller un peu plus vite ensuite...

Mais on monte un tableau résultat dont on ne connaît pas le nombre de lignes, ni le nombre de colonnes, on fait donc une première boucle sur les lignes du tableau pour repérer l'écart maximal entre 2 lignes vides, ce qui permettra de fixer la dimension colonnes et d'incrémenter les lignes au fur et à mesure.

Deuxième boucle sur le tableau origine : on ouvre une ligne résultat chaque fois qu'on rencontre "Chemin" (et on sert les 3 premières colonnes), on complète la ligne à chaque ligne suivante non vide en incrémentant l'indice colonne, et lorsqu'on rencontre une ligne vide on incrémente l'indice ligne.

Cordialement.

Bonjour,

Merci pour votre réactivité et votre réponse, que je vais m'efforcer d'appréhender... Je suis moins surpris de ne pas y être arrivé car ça dépasse de loin mes connaissances VBA (actuelles, j'espère).

Toutefois, J'ai une anomalie quand je veux tester : Ch(j, n) = orig(i, 1) "l'indice n'appartient pas à la sélection"

Je vous confirme que le tableau commence à la ligne 3 pour se terminer à plus de 60000 lignes. Mais la structure reste exactement la même que celle fournie en exemple.

Bien cordialement

La procédure fonctionne sur le modèle, et il n'y a aucune raison qu'elle cesse de fonctionner si le tableau a la même structure et les mêmes caractéristiques !

Il y a donc lieu si tu as une erreur de chercher de qui diffère du modèle présenté à l'emplacement où se produit l'erreur.

D'abord, quand l'erreur d'exécution se produit, il convient de localiser l'emplacement du tableau en cause : après avoir cliqué sur débogage, vu sur quelle ligne l'erreur s'était produite, relever les valeurs des variables concernées. Pour cela ces valeurs apparaissent en info-bulle au survol du nom de la variable par le curseur.

Au cas particulier, vu la nature de l'erreur, si le défaut d'indice porte probablement sur j, il convient surtout de relever la valeur de i qui indiquera l'emplacement du tableau source à contrôler.

La valeur de j est à relever également, de même que la valeur de k : k n'est pas concernée directement par cette ligne mais si la valeur de j dépasse la valeur de k, cela manifeste le défaut d'indice, qui peut résulter d'un défaut d'incrémentation de j ou d'un défaut de la détermination de k (alors en amont...)

Muni de la valeur de i, en ajoutant 2 on a la ligne du tableau source sur la feuille (la ligne 1 du tableau orig est la ligne 3 de la feuille...) : il faut donc s'y rendre et examiner en détail tout le bloc Chemin auquel elle appartient.

La structure générale doit montrer une ligne vide avant chaque ligne Chemin, et aucune autre, s'en assurer.

Une ligne peut ne pas avoir été correctement identifiée : une ligne qui paraît vide mais qui en fait ne l'est pas, ou pour la ligne Chemin, "Chemin" qui serait par exemple écrit "chemin" ou afflublé d'espaces parasites avant ou après.

On regarde si le nombre de colonne à servir pour ce bloc (soit 3 pour la première ligne et 1 par ligne suivante) ne dépasse pas k+1 (parce que k est l'indice colonne max. du tableau résultat qui débute à 0).

Cela te fait une bonne série de vérifications à opérer.

Bon courage.

Re

Merci pour ton aide qui va me guider pour les recherches à opérer.

Cordialement

Salut dss,

Bien le bonjour MFerrand,

à peu de chose près identique :

• je calcule dès le départ le nombre de lignes à partir du nombre de "Chemin" (countif) en [A:A];
• le nombre de lignes entre "Chemin" ensuite pour REDIM en fonction.
• à la lecture du souci rencontré, je fais une recherche avec LIKE "CHEMIN*"

Double-clic n'importe où pour démarrer la macro.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract()
'
Cancel = True
tData = Range("A3:C" & Range("A" & Rows.Count).End(xlUp).Row + 1).Value
'
lFlag = WorksheetFunction.CountIf(Range("A:A"), UCase("Chemin*"))
ReDim tExtract(lFlag, 1)
For x = 1 To UBound(tData, 1)
    If UCase(tData(x, 1)) Like "CHEMIN*" Then
        iIdx = iIdx + 1
        For y = x + 1 To UBound(tData, 1)
            If tData(y, 1) Like UCase("Chemin*") Or tData(y, 1) = "" Then
                If (y - x) + 3 > UBound(tExtract, 2) Then ReDim Preserve tExtract(lFlag, (y - x) + 3)
                Exit For
            End If
        Next
        tExtract(iIdx - 1, 0) = tData(x, 1): tExtract(iIdx - 1, 1) = tData(x, 2): tExtract(iIdx - 1, 2) = tData(x, 3)
        For Z = x + 1 To y - 1
            tExtract(iIdx - 1, 3 + (Z - (x + 1))) = tData(Z, 1)
        Next
    End If
Next
With Worksheets("Extract")
    .Cells.ClearContents
    .Range("A1").Resize(UBound(tExtract, 1), UBound(tExtract, 2)).Value = tExtract
    .Columns.AutoFit
    .Activate
End With
'
End Sub

A+

Bonsoir,

Merci pour ton envoi. Je vais tester et vous tiendrai tous deux au courant du résultat de mes recherches.

Encore merci de votre aide

Bien cordialement

Pour le plaisir du code...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract(), lFlag&, iEnd%
'
Cancel = True
tData = Range("A3:C" & Range("A" & Rows.Count).End(xlUp).Row + 1).Value
'
lFlag = WorksheetFunction.CountIf(Range("A:A"), UCase("*Chemin*"))
ReDim tExtract(lFlag, 3)
For x = UBound(tData, 1) - 1 To 1 Step -1
    If tData(x, 1) <> "" And (tData(x + 1, 1) = "" Or UCase(tData(x + 1, 1)) Like "*CHEMIN*") Then iEnd = x
    If UCase(tData(x, 1)) Like "*CHEMIN*" Then
        lFlag = lFlag - 1
        tExtract(lFlag, 0) = tData(x, 1): tExtract(lFlag, 1) = tData(x, 2): tExtract(lFlag, 2) = tData(x, 3)
        If (iEnd - x) + 3 > UBound(tExtract, 2) Then ReDim Preserve tExtract(WorksheetFunction.CountIf(Range("A:A"), UCase("*Chemin*")), (iEnd - x) + 3)
        For y = x + 1 To iEnd
            tExtract(lFlag, 3 + (y - (x + 1))) = tData(y, 1)
        Next
    End If
Next
With Worksheets("Extract")
    .Cells.ClearContents
    .Range("A1").Resize(UBound(tExtract, 1), UBound(tExtract, 2)).Value = tExtract
    .Columns.AutoFit
    .Activate
End With
'
End Sub

A+

Salut Curulis,

C'est vrai que je me suis laissé aller à l'habitude d'avoir un nombre de le lignes variables, cas le plus fréquent, alors que là on pouvait tout aussi facilement sinon plus calculer préalablement le nombre de lignes, et éviter d'avoir à transposer...

Bonne idée de ta part !

Autre idée, pour 60000 lignes, il pourrait s'avérer intéressant d'utiliser un dico...

Attendons la suite.

Bonjour MFerrand, Curulis,

Je reviens vers vous après avoir testé vos 2 solutions.

Tout d'abord, mea culpa MFerrand par rapport à mon fichier exemple dans lequel j'indiquais que le fichier présentait toujours la même structure : tu avais raison quelques lignes possèdent uniquement la ligne chemin (des milliers après la première ) : je les ai supprimé avec une macro et effectivement le programme fonctionne à merveille si ce n'est que le résultat s'affiche après plus de 40000 lignes mais ce n'est pas un souci, il me suffit d'incorporer une macro après ton programme pour les supprimer. Grand merci à toi encore une fois.

Curulis, après avoir créée la feuille extract, ça fonctionne également à merveille (sans avoir besoin de rechercher les blocs qui n'ont pas la même structure. Grand merci à toi également.

Et je vous avoue que je suis impressionné par votre maîtrise du code et vous remercie sincèrement de faire partager vos talents.

Je vous avoue également que n'étant pas familiarisé avec les tableaux (qui vont beaucoup plus vite) j'ai quelques difficultés à assimiler la solution. Mais j'y travaille...

En fait, je me suis "battu" avec deux boucles for imbriquées (ligne et colonne) sans résultat. Serait-ce trop vous demander si cela est possible de me fournir un exemple avec cette solution.

Pour terminer, le fichier d'origine possède près de 130000 lignes. Avant de faire appel au forum, j'ai développé des petites macros pour faire le tri et arriver vers les 60000 lignes. Puis comme énoncé plus haut, je me suis tourné vers le forum n'arrivant pas à transposer les lignes en colonnes. Pour un fichier qui fait au final un peu moins de 10000 lignes.

Cependant, sur le fichier d'origine ma macro plante 4 fois exactement sur des lignes intitulées en colonne C : NOM? précédée d'un dièse (sous ce vocable se cache une donnée telle : -evaluation ou =-fiches provenant de sous répertoires mal nommés. Impossible pour ma part à les repérer par la macro, le programme plante 4 fois et je rectifie en conséquence le fichier d'origine. Y-a-t-il un moyen de les repérer à priori?

Avec tous mes sincères remerciements

En vous souhaitant une bonne journée

Bien cordialement

Bonjour,

Je suis tenté de tester une procédure utilisant un dico, qui pourrait s'adapter à quelques variations... Ce qu'il faudrait savoir c'est si le chemin indiqué en colonne C sur les lignes "chemin" est susceptible d'avoir des doublons ou non ?

Si je trouve un moment dans l'après-midi entre rebouchages de trous et percement d'autres , je vais tâcher de concocter quelque chose après test sur un point sur lequel j'ai encore un doute...

Cordialement.

Bonjour,

Pour répondre à ta question, j'ai tendance à te dire que le chemin est unique puisqu'il reprend l'arborescence d'un disque : Racine puis Repertoire principal puis sous repertoire consécutifs. Les lignes sous chaque chemin reprennent les droits utilisateurs (avec autant de lignes que d'utilisateurs autorisés sur le chemin concerné).

Mais je ne peux pas te le certifier à 100% ne pouvant vérifier une à une quelques 130000 lignes.

La transposition lignes en colonnes a pour effet de lire les droits utilisateurs attachés à chaque chemin non plus en ligne mais directement en colonne.

Tous deux m'avez déjà rendu un grand service pour finaliser le programme et ainsi arriver à bout du but initialement recherché.

Alors aucune urgence en la matière car j'ai déjà le résultat escompté.

Pour avoir buté pas mal de temps sur le problème, pourriez-vous me dire à l'occasion si ce résultat aurait pu être atteint à partir d'une boucle for imbriquée lignes et colonnes, le principe d'imbrication me donnant du souci (question de curiosité).

Bon courage pour tes travaux en cours

Une fois encore merci de m'avoir répondu aussi rapidement, ça m'a enlevé une belle épine du pied.

Cordialement

Salut dss,

la solution que tu souhaitais essayer!

Patience, hein! 60.000 lignes à mouliner ainsi, cela risque de prendre un petit moment...

Dim sWk As Worksheet
Set sWk = Worksheets("Extract")
'
Application.ScreenUpdating = False
'
sWk.Cells.ClearContents
iRowA = Range("A" & Rows.Count).End(xlUp).Row
For x = 3 To iRowA
    If UCase(Range("A" & x).Value) Like "*CHEMIN*" Then
        iRow = iRow + 1
        sWk.Range("A" & iRow & ":C" & iRow).Value = Range("A" & x & ":C" & x).Value
        For y = x + 1 To iRowA
            If Cells(y, 1) <> "" And Not UCase(Cells(y, 1)) Like "*CHEMIN*" Then
                iCol = sWk.Cells(iRow, Columns.Count).End(xlToLeft).Column + 1
                sWk.Cells(iRow, iCol) = Range("A" & y).Value
            Else
                x = y - 1
                Exit For
            End If
        Next
    End If
Next
'
Application.ScreenUpdating = True

A+

Bonjour Curulis,

Merci encore une fois pour ton aide. Je n'ai plus qu'à "bosser" le code en espérant tout comprendre in fine.

C'est en tous cas pour moi un bon exercice d'entrainement aux boucles imbriquées qui me servira par la suite car je n'aurai pas souvent des fichiers aussi volumineux que celui-là.

Bonne journée

Cordialement