Bonjour à tous,
Je suis actuellement en stage dans une entreprise de transport qui utilise une macro pour identifier les livraisons qui n'ont pas encore été affectées à un chauffeur.
Depuis quelques semaine maintenant la maco ne fonctionne plus correctement car la liste des livraisons s'est allongée.
Un premier fichier contient la liste des tournées à affecter (Fichier TOURS)
Un autre fichier contient les plannings (GRISPR)
Enfin le dernier sert à faire le test (TEST)
Le but de la macro est d'aller voir quelles tournées sont saisies (Identifiée par un N° de tour) dans le fichier GRISPR, de comparer ces dernières avec la liste du fichier TOURS et enfin d'aller écrire dans le fichier TEST dans une colonne les tournées déjà affectées, dans une autres celles non saisies et enfin de reperer les doublons dans une 3eme.
Hors depuis que la liste des tournées à augmenter la macro n'est plus capable de reperer au-delà de la ligne 400. J'ai essayer d'augmenter les bornes de la boucle que la macro effectue mais celà renvi une erreure de type 9.
'**********************************************************
' Procédure TEST
'
' Parcours les fichiers GRISPRxx.XLS et TOURS.XLS
' Pour vérifier que toutes les tournées ont été attribuées
' Que toutes les tournées attribuées existent
' Qu'elles n'ont pas été attribuées en double
'
'**********************************************************
'.........
'sur [Ctrl] [T]
'.........
Sub Test()
'***Déclaration des variables***
Dim i, j, k, plus As Integer
Dim IndexTour, IndexInex, IndexNonAff, IndexDoub As Integer
Dim Trouve As Boolean
Dim TestTour(600, 6)
'***Initialisations de Test***
Application.ScreenUpdating = False
Workbooks("TOURS.XLS").Activate
i = 3
'***Initialisation du tableau TestTour***
While (Cells(i, 1) <> "") And (i <= 600)
TestTour(i - 3, 0) = Cells(i, 1).Value
TestTour(i - 3, 1) = Cells(i, 5).Value
TestTour(i - 3, 2) = Cells(i, 2).Value
TestTour(i - 3, 3) = Cells(i, 3).Value
TestTour(i - 3, 4) = Cells(i, 4).Value
i = i + 1
Wend
'***Test des tournées saisie***
ThisWorkbook.Activate
plus = 0
'***Parcours de la feuille de calcul pour recenser les tournées saisies***
For i = 5 To 105
For j = 3 To 17
If Cells(i, j).Value <> "" Then
Trouve = False
k = 0
'***Recherche de la tournée parmis les tournées existantes***
While ((Not Trouve) And (k < 400))
'Traitement en cas d'existance***
If TestTour(k, 0) = Cells(i, j).Value Then
Trouve = True
TestTour(k, 1) = TestTour(k, 1) + 1
End If
k = k + 1
Wend
'***Traitemant en cas d'inexistance***
If Not Trouve Then
plus = plus + 1
TestTour(400 + plus, 0) = Cells(i, j).Value
TestTour(400 + plus, 1) = "INEXISTANTE"
End If
End If
Next j
Next i
'***Initialisations d'affichage***
Workbooks("TEST.XLS").Activate
IndexInex = 0
IndexNonAff = 0
IndexDoub = 0
'***Effacement des anciennes données***
For i = 2 To 600
For j = 1 To 10
Cells(i, j).Value = ""
Next j
Next i
'***Affichage des résulttats du test***
For IndexTour = 0 To 400 + plus
Cells(IndexTour + 2, 1).Value = TestTour(IndexTour + 1, 0)
Cells(IndexTour + 2, 2).Value = TestTour(IndexTour + 1, 2)
'***Traitement en cas d'inexistance***
If TestTour(IndexTour, 1) = "INEXISTANTE" Then
IndexInex = IndexInex + 1
Cells(IndexInex + 1, 3).Value = TestTour(IndexTour, 0)
Else
'***Traitement en cas de non affectation***
If ((TestTour(IndexTour, 0) < 1001) And (TestTour(IndexTour, 1) = 0)) Then
IndexNonAff = IndexNonAff + 1
Cells(IndexNonAff + 1, 4).Value = TestTour(IndexTour, 0)
Cells(IndexNonAff + 1, 5).Value = TestTour(IndexTour, 2)
Cells(IndexNonAff + 1, 6).Value = TestTour(IndexTour, 3)
Cells(IndexNonAff + 1, 7).Value = TestTour(IndexTour, 4)
Else
'***Traitement en cas d'affectation multiple***
If TestTour(IndexTour, 1) > 1 Then
IndexDoub = IndexDoub + 1
Cells(IndexDoub + 1, 8) = TestTour(IndexTour, 0)
Cells(IndexDoub + 1, 9) = TestTour(IndexTour, 2)
Cells(IndexDoub + 1, 10) = TestTour(IndexTour, 1)
End If
End If
End If
Next IndexTour
'***Ordonner les tournées inexistantes dansl'ordre croissant***
Columns("C:C").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
Ceci est le code de "Base", avant modification des bornes. Si quelqu'un à une idée de pourquoi cette erreur 9 dès que je touche à la taille des bornes je le remercie d'avance.
PS : Je ne peux pas mettre les fichier pour le moment, je ferais ça en rentrant ce soir.
Je suis actuellement en stage dans une entreprise de transport qui utilise une macro pour identifier les livraisons qui n'ont pas encore été affectées à un chauffeur.
Depuis quelques semaine maintenant la maco ne fonctionne plus correctement car la liste des livraisons s'est allongée.
Un premier fichier contient la liste des tournées à affecter (Fichier TOURS)
Un autre fichier contient les plannings (GRISPR)
Enfin le dernier sert à faire le test (TEST)
Le but de la macro est d'aller voir quelles tournées sont saisies (Identifiée par un N° de tour) dans le fichier GRISPR, de comparer ces dernières avec la liste du fichier TOURS et enfin d'aller écrire dans le fichier TEST dans une colonne les tournées déjà affectées, dans une autres celles non saisies et enfin de reperer les doublons dans une 3eme.
Hors depuis que la liste des tournées à augmenter la macro n'est plus capable de reperer au-delà de la ligne 400. J'ai essayer d'augmenter les bornes de la boucle que la macro effectue mais celà renvi une erreure de type 9.
'**********************************************************
' Procédure TEST
'
' Parcours les fichiers GRISPRxx.XLS et TOURS.XLS
' Pour vérifier que toutes les tournées ont été attribuées
' Que toutes les tournées attribuées existent
' Qu'elles n'ont pas été attribuées en double
'
'**********************************************************
'.........
'sur [Ctrl] [T]
'.........
Sub Test()
'***Déclaration des variables***
Dim i, j, k, plus As Integer
Dim IndexTour, IndexInex, IndexNonAff, IndexDoub As Integer
Dim Trouve As Boolean
Dim TestTour(600, 6)
'***Initialisations de Test***
Application.ScreenUpdating = False
Workbooks("TOURS.XLS").Activate
i = 3
'***Initialisation du tableau TestTour***
While (Cells(i, 1) <> "") And (i <= 600)
TestTour(i - 3, 0) = Cells(i, 1).Value
TestTour(i - 3, 1) = Cells(i, 5).Value
TestTour(i - 3, 2) = Cells(i, 2).Value
TestTour(i - 3, 3) = Cells(i, 3).Value
TestTour(i - 3, 4) = Cells(i, 4).Value
i = i + 1
Wend
'***Test des tournées saisie***
ThisWorkbook.Activate
plus = 0
'***Parcours de la feuille de calcul pour recenser les tournées saisies***
For i = 5 To 105
For j = 3 To 17
If Cells(i, j).Value <> "" Then
Trouve = False
k = 0
'***Recherche de la tournée parmis les tournées existantes***
While ((Not Trouve) And (k < 400))
'Traitement en cas d'existance***
If TestTour(k, 0) = Cells(i, j).Value Then
Trouve = True
TestTour(k, 1) = TestTour(k, 1) + 1
End If
k = k + 1
Wend
'***Traitemant en cas d'inexistance***
If Not Trouve Then
plus = plus + 1
TestTour(400 + plus, 0) = Cells(i, j).Value
TestTour(400 + plus, 1) = "INEXISTANTE"
End If
End If
Next j
Next i
'***Initialisations d'affichage***
Workbooks("TEST.XLS").Activate
IndexInex = 0
IndexNonAff = 0
IndexDoub = 0
'***Effacement des anciennes données***
For i = 2 To 600
For j = 1 To 10
Cells(i, j).Value = ""
Next j
Next i
'***Affichage des résulttats du test***
For IndexTour = 0 To 400 + plus
Cells(IndexTour + 2, 1).Value = TestTour(IndexTour + 1, 0)
Cells(IndexTour + 2, 2).Value = TestTour(IndexTour + 1, 2)
'***Traitement en cas d'inexistance***
If TestTour(IndexTour, 1) = "INEXISTANTE" Then
IndexInex = IndexInex + 1
Cells(IndexInex + 1, 3).Value = TestTour(IndexTour, 0)
Else
'***Traitement en cas de non affectation***
If ((TestTour(IndexTour, 0) < 1001) And (TestTour(IndexTour, 1) = 0)) Then
IndexNonAff = IndexNonAff + 1
Cells(IndexNonAff + 1, 4).Value = TestTour(IndexTour, 0)
Cells(IndexNonAff + 1, 5).Value = TestTour(IndexTour, 2)
Cells(IndexNonAff + 1, 6).Value = TestTour(IndexTour, 3)
Cells(IndexNonAff + 1, 7).Value = TestTour(IndexTour, 4)
Else
'***Traitement en cas d'affectation multiple***
If TestTour(IndexTour, 1) > 1 Then
IndexDoub = IndexDoub + 1
Cells(IndexDoub + 1, 8) = TestTour(IndexTour, 0)
Cells(IndexDoub + 1, 9) = TestTour(IndexTour, 2)
Cells(IndexDoub + 1, 10) = TestTour(IndexTour, 1)
End If
End If
End If
Next IndexTour
'***Ordonner les tournées inexistantes dansl'ordre croissant***
Columns("C:C").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
Ceci est le code de "Base", avant modification des bornes. Si quelqu'un à une idée de pourquoi cette erreur 9 dès que je touche à la taille des bornes je le remercie d'avance.
PS : Je ne peux pas mettre les fichier pour le moment, je ferais ça en rentrant ce soir.
