XL 2016 créer un tableau qui contient tous les distances entre les stations de bus

nasri badreddine

XLDnaute Nouveau
bonjour;
j'ai un tableau A (input) comporte 5 colonnes (centre,ligne, n°station,nom station, distance (représente la distance entre les station adjacente de chaque ligne)
je voulais créer un tableau B comporte 5 colonne (centre,ligne,station départ X,station arrivé Y,distance entre XY)
la distance entre XY est:
exemple pour la ligne 222 du centre 15 X=3 Y=5
distance entre station 3 et station 5 = (distance entre station 3 et 4) + (distance entre station 4 et 5)
pouvez vous m'aidez de créer le tableau B (formule excel,code vba) et merci d'avance
 

Pièces jointes

  • distances1.xlsx
    442.3 KB · Affichages: 8

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour nasri badreddine, JHA,
Une autre approche en VBA.
Plus lent je pense que des formules au calcul, mais ne recalcule pas à chaque Recalcul, et génère un fichier plus léger, avec :
VB:
Public T, Centre%, Ligne%, Dep%, Arr%, D%, N%
Sub Distance()
T = Sheets("tableau A (input)").[A1].CurrentRegion  ' Données dans array, plus rapide
Application.ScreenUpdating = False
DL = Cells(Cells.Rows.Count, "A").End(xlUp).Row     ' Dernière ligne tableau B
For L = 2 To DL
    Centre = Cells(L, "A"): Ligne = Cells(L, "B"): Dep = Cells(L, "C"): Arr = Cells(L, "D") ' Acquisition
    CalculDistance                                  ' Calcul de la distance
    Cells(L, "E") = D                               ' Ecriture distance
    ' Info progression dans statusbar ... pour faire patienter
    N = N + 1
    If N = 100 Then
        N = 0: Application.StatusBar = "Progression :  " & Format(L / DL, "0%")
    End If
Next L
Application.StatusBar = ""
End Sub
Sub CalculDistance()
D = 0: L = 2
While T(L, 1) <> Centre: L = L + 1: Wend        ' Début Centre
While T(L, 2) <> Ligne: L = L + 1: Wend         ' Début Ligne
While T(L, 3) <> Dep: L = L + 1: Wend           ' Début Départ
L = L + 1
Ldeb = L                                        ' Ligne de début
While T(L, 3) <> Arr: L = L + 1: Wend           ' Début Arrivée
Lfin = L                                        ' Ligne de fin
For L = Ldeb To Lfin
    D = D + T(L, 5)                             ' On ajoute la distance
Next L
End Sub
 

Pièces jointes

  • distances1.xlsm
    625.3 KB · Affichages: 8

nasri badreddine

XLDnaute Nouveau
Bonjour nasri badreddine, JHA,
Une autre approche en VBA.
Plus lent je pense que des formules au calcul, mais ne recalcule pas à chaque Recalcul, et génère un fichier plus léger, avec :
VB:
Public T, Centre%, Ligne%, Dep%, Arr%, D%, N%
Sub Distance()
T = Sheets("tableau A (input)").[A1].CurrentRegion  ' Données dans array, plus rapide
Application.ScreenUpdating = False
DL = Cells(Cells.Rows.Count, "A").End(xlUp).Row     ' Dernière ligne tableau B
For L = 2 To DL
    Centre = Cells(L, "A"): Ligne = Cells(L, "B"): Dep = Cells(L, "C"): Arr = Cells(L, "D") ' Acquisition
    CalculDistance                                  ' Calcul de la distance
    Cells(L, "E") = D                               ' Ecriture distance
    ' Info progression dans statusbar ... pour faire patienter
    N = N + 1
    If N = 100 Then
        N = 0: Application.StatusBar = "Progression :  " & Format(L / DL, "0%")
    End If
Next L
Application.StatusBar = ""
End Sub
Sub CalculDistance()
D = 0: L = 2
While T(L, 1) <> Centre: L = L + 1: Wend        ' Début Centre
While T(L, 2) <> Ligne: L = L + 1: Wend         ' Début Ligne
While T(L, 3) <> Dep: L = L + 1: Wend           ' Début Départ
L = L + 1
Ldeb = L                                        ' Ligne de début
While T(L, 3) <> Arr: L = L + 1: Wend           ' Début Arrivée
Lfin = L                                        ' Ligne de fin
For L = Ldeb To Lfin
    D = D + T(L, 5)                             ' On ajoute la distance
Next L
End Sub
ça marche aussi merci merci merci beaucoup
 

Discussions similaires

Statistiques des forums

Discussions
312 207
Messages
2 086 234
Membres
103 162
dernier inscrit
fcfg