XL 2019 Créer des dossiers et sous dossiers avec VBA

[Linda42]

Bonjour,

J'ai un début de code VBA mais qui fonctionne uniquement sur une liste de noms les uns à la suite des autres dans une seul colonne.
Je tente de créer des dossiers et les sous dossier selon les infos dans les colonnes suivants. Colonne A, Dossier racine, colonne B sous dossier, colonne C sous dossier de la colonne B etc....
Pouvez vous m'aider à corriger mon code.

Merci

 

[TooFatBoy]

Arf, je n'ai pas vu ce "détail"... 😕

Tu as raison vgendron, il y a deux lignes sur lesquelles il y a deux dossiers imbriqués.

Manifestement c'est une erreur de saisie, mais elle existe. Bien vu. 👍

 

[patricktoulon]

a oui effectivement en mettant les colonne en autofit il y a deux erreurs on le voit bien
un +pour @vgendron

 

[vgendron]

@patricktoulon

puisqu'il vous faut la preuve par l"image avec VOTRE solution, la seule et unique qui vaut la peine
voici VOTRE fichier
Dans la feuille test, les données TELLES quelles du demandeur de ce fil

dans votre macro pour créer les chemins (qui ne créé aucun chemin...)
j'ai ajouté 3 lignes de code
=> une pour copier le chemin que votre code constitue dans la colonne E
puis une simple boucle pour creer les chemins..

 

[patricktoulon]

que les choses soient claire j'ai donné un algo pour reconstituer la table sans doublons , pas pour créer les dossiers
comme je l'ai dit tout à l'heure tu relis la table ensuite ligne par ligne en créant le chemin avec les 4 colonnes +la racine

 

[patricktoulon]

si tu veux on reprend comme j'ai dit mon algo et on le fait mais avec une variable tableau
en bonus une petite sub pour supprimer le dossier complet in one shot(ce qui est impossible avec remdir

Sub Comble_les_blancs_V_TBL()
    Cells(1, 8).Resize(3000, 100).Clear
    Dim lig&, c&, Nom$
    Application.ScreenUpdating = False
    With ActiveSheet.UsedRange
        tbl = .Value:        ReDim tbf(UBound(tbl))
        'le premier dossier  en colonne 1
        For i = 3 To UBound(tbl)
            tbl(i, 1) = tbl(2, 1)
           Next
        'les dossier manquant dans le tableau
        For c = 2 To 4
            Nom = ""
            For lig = 3 To UBound(tbl)

                'If WorksheetFunction.CountA(.Cells(lig, 2).Resize(, 4)) > 0 Then
                ca = 0: For x = 2 To 4: ca = ca + (1 And tbl(lig, x) <> ""): Next
                If ca > 0 Then

                    'If .Cells(lig, c) <> "" Then
                    'Nom = .Cells(lig, c)
                    'Else
                    'If .Cells(lig, c - 1) = Cells(lig - 1, c - 1) And .Cells(lig, c - 1) <> "" Then
                    '.Cells(lig, c) = Nom
                    '.Cells(lig, c).Font.Color = vbRed
                    'End If
                    'End If

                    If tbl(lig, c) <> "" Then
                        Nom = tbl(lig, c)
                    Else
                        If tbl(lig, c - 1) = tbl(lig - 1, c - 1) And tbl(lig, c - 1) <> "" Then
                            tbl(lig, c) = Nom
                        End If
                    End If
                End If
                'If WorksheetFunction.CountA(.Cells(lig, 1).Resize(, 4)) = 1 Then tbl(lig, 1) = ""
                ca = 0: For x = 1 To 4: ca = ca + (1 * Abs(tbl(lig, x) <> "")): Next
                If ca = 1 Then tbl(lig, 1) = ""

            Next
        Next
    End With
    ' Cells(1, 8).Resize(UBound(tbl), 4) = tbl

    'reconstruction  des chemin  et creation
    racine = Environ("userprofile") & "\desktop\"
    For i = 2 To UBound(tbl)
        For c = 1 To UBound(tbl, 2)
            tbf(i) = tbf(i) & IIf(tbl(i, c) <> "", tbl(i, c) & "\", "")
        Next
        If tbf(i) <> "" Then MkDir racine & tbf(i)
    Next
    Cells(1, 8).Resize(UBound(tbl), 1) = Application.Transpose(tbf)
End Sub

Sub supprimdossiercomplet()
    dossier = Environ("userprofile") & "\desktop\" & Cells(2, 1)
    Shell ("cmd /c RD /S /Q " & dossier)
    Do While Dir(dossier, vbDirectory) <> "": DoEvents: Loop
End Sub

j'ai juste remplacé les .cells(lig,c) par tbl(lig,c) et remplacé les deux test countA et a la fin comme je te l'ai dis on relis la table(en l’occurrence ici le tbl)pour crer le chemin
la liste des chemin s'affiche a partir de la colonne 8 en même temps
voila le raisonnement est le même
j'ai même laissé les lignes blanches 🤣 🤣