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]

Ca marche, je viens de jeter un oeil sur le second forum.
Si tout est ok, c'est super pour ton projet.

 

[Anthony115]

Merci beaucoup pour ton (votre) aide et pour le temps passé

A bientôt

 

[thebenoit59]

Pourrais-tu me transmettre le fichier complet pour que j'y jette un oeil ?

 

[Anthony115]

Je ne peux te transmettre le fichier complet car les données sont confidentielles :/
Si c'est pour avoir l'ensemble des codes je peux te transmettre le fichier en changeant les données ?

 

[thebenoit59]

Si ça ne te dérange pas.

 

[Anthony115]

Pas de problème,
Voici un exemple simplifié avec les différentes étapes (boutons à droite de la feuille).
Les différentes étapes sont voulues, cela me permet de faire des vérifications au cours du temps.

Nb: Pour "3) Chemin" il faut enlever les " ' " dans le code.

 

[Anthony115]

Je viens de voir que j'ai un petit souci au niveau du code trouvé par gaz0line (calcul de la colonne Z et AA), il fonctionne très bien mais le temps d’exécution est très important.
Même en scindant en plusieurs fichier comme je l'ai fait pour les chemins, ça met beaucoup de temps.

Est-ce que tu vois une alternative simple ou je le laisser tourné?

 

[thebenoit59]

Il doit y avoir plus simple sans doute, je regarderai ça quand j'aurai du temps pour.
Le plus simple et rapide serait de ne pas dissocier les deux codes, à mon avis, pendant la procédure de création du chemin, rien n'empêche d'enregistrer la somme de la colonne B et de la colonne C séparément, pour ensuite faire le produit au moment de l'inscription des valeurs.

 

[thebenoit59]

Bonjour Anthony.

En partant sur l'utilisation de Tableaux virtuels, j'ai développé un code.
Sur le fichier joint il est plus long de 0.02 seconde par rapport à celui de Gaz0line, à tester sur ton fichier complet, je pense qu'il sera sans doute plus rapide.

Le code :

Option Explicit

Dim dA As Object, dB As Object
Dim Z#, AA#

Sub Calculs_Z_AA()
Dim f As Worksheet, i&, l&, Tableau(), Temp

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

Set f = Sheets("Echantillon")

'Nous définissons la dernière ligne et le tableau.
With f
    l = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Tableau = .Range(.Cells(2, "A"), .Cells(l, "AA")).Value
End With

'Nous enregistrons les valeurs correspondantes à chaque numéro.
Call Enregistrement_Dictionnaires(Tableau)

'Nous allons boucler le tableau pour calculer les valeurs en Z et AA.
'Ces valeurs seront inscrites dans le tableau fictif.
For i = LBound(Tableau, 1) To UBound(Tableau, 1)
    If Tableau(i, 5) = "Faux" Then
        Tableau(i, 26) = "Faux"
        Tableau(i, 27) = "Faux"
    ElseIf Tableau(i, 5) <> "" Then
        Temp = Split(Tableau(i, 5), "-")
        Call Calcul_Z_AA(Temp)
        Tableau(i, 26) = (Tableau(i, 14) + Z) ^ 2 + (Tableau(i, 15) + AA) ^ 2
        Tableau(i, 27) = Tableau(i, 26) * 10
    End If
Next i

'On extrait les valeurs dans la colonne Z et AA
f.Range("Z2").Resize(UBound(Tableau), 2).Value = Application.Index(Tableau, Evaluate("Row(" & LBound(Tableau) & ":" & UBound(Tableau) & ")"), Array(26, 27))

'Réactivation des applications.
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With

End Sub

Sub Enregistrement_Dictionnaires(Tableau())
Dim i&

'Nous créons les deux dictionnaires.
Set dA = CreateObject("Scripting.Dictionary")
Set dB = CreateObject("Scripting.Dictionary")

'Nous enregistrons les valeurs E+F dans dA et G+H dans dB.
For i = LBound(Tableau, 1) To UBound(Tableau, 1)
    If Tableau(i, 1) <> "" Then
        dA(Tableau(i, 1)) = Tableau(i, 22) + Tableau(i, 23)
        dB(Tableau(i, 1)) = Tableau(i, 24) + Tableau(i, 25)
    End If
Next i
End Sub

Sub Calcul_Z_AA(Tableau As Variant)
Dim i&

'Nous remettons Z et AA à zéro.
    Z = 0
    AA = 0
   
'Nous allons boucler le tableau.
For i = LBound(Tableau) To UBound(Tableau)
    Z = Z + dA(CDbl(Tableau(i)))
    AA = AA + dB(CDbl(Tableau(i)))
Next i
End Sub

 

[Anthony115]

Bonjour thebenoit59,


Merci pour ta réponse, ton code fonctionne sur le fichier que joint précédemment mais j'ai 2 problèmes:


1) Modification du calcul:

Dans le calcul réalisé dans la colonne Z, je souhaiterai prendre en compte les valeurs qui se trouvent dans les colonnes 14 et 15, le tout en la racine carré.


Voir ligne de code jointe:

 'Tableau(i, 26) = Sqr(((Cells(i, 14).Value) + 1.5 * (Tableau(i, 14) + Z)) ^ 2 + ((3*Cells(i, 15).Value) + (Tableau(i, 15) + AA)) ^ 2)

2) Quand je teste le code sur 100 000 lignes il me met un message d'erreur?





Je te joins le fichier avec les 100 000 lignes (en 2 parties car trop volumineux)

 

[Anthony115]

Parie 2

En voulant réduire le fichier pour qu'il passe, je me suis rendu compte que le message d'erreur ne s'affiche plus quand j'ai 50 000 lignes

 

[thebenoit59]

L'erreur est normale.
En effet, tu mélanges les Cells et le Tableau.
La formule correcte donnerait :

Tableau(i, 26) = Sqr(((Tableau(i, 14)) + 1.5 * (Tableau(i, 14) + Z)) ^ 2 + ((3 * Tableau(i, 15)) + (Tableau(i, 15) + AA)) ^ 2)

Je te laisse vérifier l'exactitude des résultats.

 

[Anthony115]

Désolé pour le temps de réponse, ça coince mais je n'arrive pas à trouver où?

Pour reprendre les choses au "propre", j'ai créé un exemple basique afin de pouvoir trouver le problème plus facilement.

Dans les colonnes AC et AD, j'ai fait le calcul que je souhaiterai "à la main".

Si j’exécute le code de gaz0line, je retrouve les mêmes résultats que ceux faits "à la main" mais pas avec ton code?

 

[thebenoit59]

Tu t'es trompée en modifiant mon code.
En effet la ligne

Tableau(i, 26) = Sqr(((1.25 * Tableau(i, 14)) + 1.5 * (Tableau(i, 22) + Tableau(i, 23) + Z)) ^ 2 + ((1.25 * Tableau(i, 15)) + (Tableau(i, 24) + Tableau(i, 25) + AA)) ^ 2)

doit être inscrite comme ceci :

Tableau(i, 26) = Sqr(((1.25 * Tableau(i, 14)) + 1.5 * Z) ^ 2 + ((1.25 * Tableau(i, 15)) + AA) ^ 2)

 

[Anthony115]

Ah oui en effet désolé, ça marche beaucoup mieux comme ça

Si je le teste sur 100 000 lignes j'ai un message d'erreur qui m'amène à la ligne:

Si tu penses savoir ce que c'est assez facilement je suis preneur sinon ne t'embête pas, je décomposerait le fichier