Construction réseau (différents chemins possibles)

[Anthony115]

Bonjour,

Je suis nouveau sur le forum et me permets de demander votre aide car je penche sur un problème depuis plusieurs jours sans trouver la solution.

Je travaille sous Excel 2007.
Je souhaiterai réaliser ce travail en VBA.

Voici un exemple "simple" pour comprendre la logique: --> voir fichier joint

Le but est d'obtenir les 3 chemins différents par VBA (a-b; a-c-e; a-d).
On sait que le tronçons a est le tronçon de départ.
On sait que les tronçons b, e et c sont à la fin du réseau.

Ou j'en suis:
J'arrive à identifier le début du réseau et donc créer le début des chemins.
Je n'arrive par a faire les recherches dans les Id1 et Id2 afin de continuer les réseau sachant que parfois le noeud amont peut se retrouver dans l'Id1 ou l'Id 2....


J'espère avoir été assez clair, dans le cas contraire je m'en excuse et suis prêt à répondre à toutes questions.

Merci par avance,
Anthony

 

[thebenoit59]

Une première ébauche en utilisant le principe de récursivité.
J'ai fixé la valeur de départ et la feuille de travail, nous pourrons l'adapter plus tard sans soucis.

 

[Anthony115]

On se rapproche du but merci beaucoup.

Quelques premières petites questions:
- Si j'ai des données dans les colonnes E et F, et vu qu'on dimensionne le tableau jusqu'à F, est ce que ça peut etre problématique par la suite ou pas du tout?
- Je me suis permis de mettre un bouton afin d’exécuter la macro, est t-il possible d'écrire seulement les résultats dans la colonne E par exemple?
Lorsque je mets de " ' " sur la 2ème partie du code, (Sub Ecriture_Précédent), ça fonctionne quand même mais je suppose que cette partie n'est pas là pour rien...?

- Si je clic une deuxième fois sur le bouton, il me dit "espace pile insuffisant", on ne peu pas écraser les anciennes données?

Merci encore thebenoit59

 

[thebenoit59]

Ouf, quand j'ai eu une notification, j'ai pensé être passé à côté de quelque chose ...
1. Tes colonnes doivent-elles être reportées également ? Si ce n'est pas le cas ce n'est pas un soucis, on écrasera les valeurs existantes dans le tableau virtuel.
2. On peut éviter la colonne avec le signe "*" sans difficulté.
3. C'est normal que tu as ce message d'erreur, on va créer une boucle infinie par rapport à la gestion du tableau je pars jusqu'à la dernière ligne remplie, ce qui nous crée le tableau deux fois.

Dans le fichier j'ai modifié le tableau pour ne plus avoir la colonne avec les "*", également je supprime le second tableau quand il y en a un.

On peut également ne sortir que la colonne résultat si nous le souhaitons, pour cela il suffira d'extraire la colonne. A toi de voir si tu veux un second tableau ou juste des résultats.

 

[Anthony115]

Bonjour thebenoit59,

Malheureusement et après de multiples tentatives, je n'ai pas pu ouvrir ta pièce jointe.

J'ai le message suivant:
Excel-Downloads - Erreur
Cette pièce jointe ne peut pas être affichée pour le moment. Veuillez réessayer plus tard.


Je vais essayer de répondre à tes questions à "l'aveugle":
- Si on peut faire sans les "*" c'est très bien.
- Je te joins un fichier (en espérant pouvoir l'ouvrir), il représente vraiment le "final" (avec 45 lignes au lieu de 200 000) mais je pense pouvoir répéter le code pour le reste des lignes...
L'idéal est d'avoir les chemins dans la colonne F (La colonne E peut être supprimée si besoin)

Anthony

 

[thebenoit59]

Je pense qu'il y a un problème avec certaines pièces jointes sur le Forum, le temps que tout soit au clair et ça ira .
Pourrais-tu transmettre le fichier avec 200k lignes pour que je puisse le tester ainsi ?
Ok j'exporterai seulement la colonne F et pas le tableau en entier. J'attends le fichier de compétition pour actualiser le code.

 

[Anthony115]

Petit bonus,
Afin de t'envoyer un fichier de compétitions propre, je souhaiterai insérer des lignes de vide dès que le "Code A" (colonne B) change.
J'ai un début de code mais j'arrive pas à le développer sur la totalité du fichier.

J'arrive à insérer une ligne suite au premier changement de valeur mais pas pour le reste.

Merci
Anthony

 

[thebenoit59]

Pour le fichier joint, tu peux utiliser ce code :

Sub Macro2()
With Sheets("Feuil1")
    For i = .Cells.Find("*", , , , xlByRows, xlPrevious).Row - 1 To 2 Step -1
        If .Cells(i, "B").Value <> .Cells(i + 1, "B") Then Rows(i + 1).Insert Shift:=xlDown
    Next i
End With
End Sub

 

[Anthony115]

Merci pour ta réponse rapide, très utile.

Désolé pour ma réponse tardive, j'ai rencontré quelques problèmes avec Excel.

De plus, je me suis rendu compte que mon fichier comportait des erreurs:
- 530 Id1 (sur les 193656) sont vides (je doit travailler en amont afin de récupérer certaines données mais je peux l'avoir que demain ou vendredi :/)
- 1 Id2 est vide
- Certaines lignes ne possèdent pas de "début"

 

[thebenoit59]

Chaque groupe correspond à un réseau c'est bien ça ?

 

[Anthony115]

Oui c'est ça, chaque groupe doit être traité indépendamment.

 

[thebenoit59]

Bonjour Anthony.

Je te poste le code plutôt que le fichier (en attendant d'être certain qu'il n'y a plus de risques).
Chez moi cela tourne bien, ça prend une dizaine de secondes (vu le nombre de lignes).

Option Explicit
Dim Tableau(), Premier$, Point$, Ligne%, d As Object

Sub Choix_Tableaux()
Dim f As Worksheet, i&, l&

'Désactivation des applications.
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With

On Error GoTo Fin

    Set f = Sheets("Test_4")
    With f
        l = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        .Range(.Cells(2, "E"), .Cells(l, "E")).Clear
        For i = 2 To l
            If .Cells(i, "D").Value <> "" Then
                Création_Chemin f.Name, .Cells(i, "D").CurrentRegion, .Cells(i, "D"), .Cells(i, "D").CurrentRegion.Row
            End If
        Next i
        .Columns(5).AutoFit
    End With

'Désactivation des applications.
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With
Exit Sub

Fin:
    MsgBox "Une erreur s'est produite ligne" & i, 16
    'Désactivation des applications.
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    Exit Sub
End Sub

Sub Création_Chemin(Feuille$, Temp As Range, Pre As Range, ii&)
Dim i%, j%
Set d = CreateObject("Scripting.Dictionary")
With Sheets(Feuille)
    Premier = Pre.Value
    Tableau = Temp.Resize(, 5).Value
    'Permet de ne pas perdre de temps avec des réseaux d'une ligne
    If UBound(Tableau) = 1 Then .Cells(ii, "E").Value = "Faux": Exit Sub
    'On vérifie qu'il y a bien une valeur dans toutes les colonnes
    For i = LBound(Tableau) To UBound(Tableau)
        For j = 1 To 3
            If Tableau(i, j) = "" Then
                .Cells(ii, "E").Value = "Manque des informations"
                .Cells(ii, "A").CurrentRegion.Interior.Color = 65535
                Exit Sub
            End If
        Next j, i
    Ecriture_Précédent Pre.Value, Pre.Offset(, -3).Value, 0
    For i = 1 To UBound(Tableau)
        If d.exists(Tableau(i, 2)) Then
            d.Remove (Tableau(i, 2))
            Tableau(i, 5) = "Faux"
        End If
    Next i
    With .Cells(ii, "E").Resize(UBound(Tableau))
        .NumberFormat = "@"
        .Value = Application.Index(Tableau, Evaluate("Row(" & LBound(Tableau) & ":" & UBound(Tableau) & ")"), 5)
    End With
End With
End Sub

Sub Ecriture_Précédent(Précédent, Point, Ligne)
Dim i%, a
For i = 1 To UBound(Tableau)
    If Tableau(i, 2) = Précédent And Tableau(i, 3) <> Premier And Ligne <> i Then a = Tableau(i, 2): Tableau(i, 2) = Tableau(i, 3): Tableau(i, 3) = a
    If Tableau(i, 3) = Précédent Then
        d(Tableau(i, 3)) = ""
        If Ligne = 0 Then
            Tableau(i, 5) = Point
            Else
            Tableau(i, 5) = Tableau(Ligne, 5) & "-" & Tableau(i, 1)
        End If
        Ecriture_Précédent Tableau(i, 2), Tableau(i, 5), i
    End If
Next i
End Sub

Maintenant nous effectuons une recherche sur la colonne D pour savoir s'il existe une ligne de départ, une fois trouvée le tableau sera créé en fonction.

Quand il manque des informations sur les colonnes A à C, je place un fond jaune et inscrit "Manque d'information" en colonne E. Je ne gère pas s'il manque la ligne de départ.

Nous noterons les résultats seulement en colonne E et non plus le tableau au complet.
J'espère que ça te convient.

 

[Anthony115]

Je n'ai pas encore mon nouveau fichier propre avec les données complétées.
Mais j'ai pu tester sur les fichiers précédents et ça fonctionne plutôt très très bien

Les colonnes en jaune quand il manque des informations, c'est vraiment génial.
J'espère que ça fonctionnera avec mes fichiers finaux mais il n'y a pas de raisons (si c'est pas le cas je t'embêterai peut-être encore un peu^^).

Un très très grand merci à toi pour ton aide, la rapidité et la qualité de tes réponses.
Merci thebenoit59

 

[thebenoit59]

Content que ça fonctionne, j'ai hâte de savoir si c'est le cas sur tes fichiers finaux.

 

[thebenoit59]

Bonjour Anthony.
J'ai reçu, pendant les vacances, un mail avec une question pour intégrer une formule.
As-tu réussi à le faire ?

 

[Anthony115]

Bonjour thebenoit59,
Oui, j'ai supposé (au vu de l'inactivité) que tu étais en vacances du coup j'ai posté dans le forum

Pour la formule des chemins, ça bloquais un peu avec les 300 000 lignes (je n'ai pas un ordi super puissant) mais je l'ai scindé en 3 fois 100 000 lignes et ça fonctionne parfaitement bien

Merci encore


Pour info (cf pj) ma question était de faire des calculs en fonctions du chemin trouvé grâce à ta formule: (solution trouvée par Gaz0line)