Bonjour à tous,
Je suis en train de faire un petit programme mais j'ai un léger problème au niveau de mes tableaux à deux dimensions.
Le code est le suivant:
..........................................................................................................................
Option Explicit
Sub Mise_a_Jour()
Dim LastLine1, LastLine2, LastLine3 As Integer
Dim I, J, K, L, M, N, O, P, Q As Integer
Dim CableTire As Double
Dim Valeur1 As String
Dim Tableau1(), Tableau2(), Tableau3(), Tableau4() As Variant
Dim Longueur_Theorique, Longueur_Posee, Longueur_Erreur, Buffer1, Buffer2, Buffer_Erreur As Variant
I = 1
J = 1
K = 1
L = 1
M = 1
N = 1
O = 1
P = 1
Q = 1
Longueur_Theorique = 0
Longueur_Posee = 0
Longueur_Erreur = 0
Buffer1 = 0
Buffer2 = 0
Buffer_Erreur = 0
'Activation de la feuille "Gestion Tourets"
Sheets("Gestion Tourets").Activate
'Recherche du numéro de la dernière ligne utilisée en colonne A
LastLine1 = Cells(Rows.Count, "A").End(xlUp).Row
'Suppression des lignes n'ayant pas un numéro de touret et des doublons
For I = LastLine1 To 1 Step -1
If Range("A" & I) = "" Then Rows(I).Delete
Next I
'Ordonnancement des tourets
Range("A1:G1").Select
ActiveWorkbook.Worksheets("Gestion Tourets").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Gestion Tourets").Sort.SortFields.Add Key:=Range( _
"A2:A648"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Gestion Tourets").Sort
.SetRange Range("A1:G648")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Suppression des doublons
Columns("A:G").Select
Range("G1").Activate
ActiveSheet.Range("$A$1:$G$49873").RemoveDuplicates Columns:=1, Header:= _
xlYes
'Recherche du numéro de la dernière ligne utilisée en colonne A et redimensionnement de Tableau1
LastLine1 = Cells(Rows.Count, "A").End(xlUp).Row
ReDim Tableau1(LastLine1)
'Copie de la liste des tourets dans Tableau1
For J = 2 To LastLine1 + 1
Tableau1(J - 1) = Range("A" & J)
Next J
'Activation de la feuille "Gestion tirage des câbles"
Sheets("Gestion tirage des câbles").Activate
'Recherche du numéro de la dernière ligne utilisée en colonne J et redimensionnement de Tableau2 et Tableau3
LastLine2 = Cells(Rows.Count, "J").End(xlUp).Row
ReDim Tableau2(LastLine2)
ReDim Tableau3(2, LastLine2)
'Copie de la liste des tourets dans Tableau1
For K = 3 To LastLine2 + 2
Tableau2(K - 2) = Range("J" & K)
Next K
'Calcul de la longueur utilisée sur chacun des tourets
For L = 3 To LastLine1 + 2
Longueur_Theorique = 0
Longueur_Posee = 0
For M = 3 To LastLine2 + 2
If Tableau1(L - 2) = Tableau2(M - 2) Then
Buffer1 = Range("H" & M)
Buffer2 = Range("I" & M)
Longueur_Theorique = Longueur_Theorique + Buffer1
Longueur_Posee = Longueur_Posee + Buffer2
Tableau3(0, L - 2) = Longueur_Theorique
Tableau3(1, L - 2) = Longueur_Posee
End If
Next M
Next L
'Activation de la feuille "Gestion des erreurs"
Sheets("Gestion des erreurs").Activate
'Ajout des longueurs des câbles tirés en erreur (doublon et mauvaise longueur)
LastLine3 = Cells(Rows.Count, "A").End(xlUp).Row
ReDim Tableau4(LastLine3)
For N = 3 To LastLine3 + 2
Tableau4(N - 2) = Range("J" & N)
Next N
For O = 3 To LastLine1 + 2
Longueur_Erreur = 0
For P = 3 To LastLine3 + 2
If Tableau1(O - 2) = Tableau4(P - 2) Then
Buffer_Erreur = Range("F" & P)
Longueur_Erreur = Longueur_Erreur + Buffer_Erreur
Tableau3(1, O - 2) = Tableau3(1, O - 2) + Longueur_Erreur
End If
Next P
Next O
'Activation de la feuille "Gestion Tourets"
Sheets("Gestion Tourets").Activate
'Insertion des longueurs calculées et calcul des longueurs restantes
For Q = 2 To LastLine1 + 1
Range("E" & Q) = Tableau3(0, Q - 1)
Range("F" & Q) = Tableau3(1, Q - 1)
Range("G" & Q).FormulaLocal = "=D" & Q & "-F" & Q
Next Q
'Activation de la feuille "Suivi du tirage de câble"
Sheets("Suivi du tirage de câble").Activate
'Mise en place des formules dans les cellules
Range("B2") = CableTire
Range("A2").Select
ActiveCell.FormulaR1C1 = "=SUM('Gestion tirage des câbles'!C[7])"
Range("A14").Select
ActiveCell.FormulaR1C1 = "=COUNTA('Gestion tirage des câbles'!C[2])-1"
Range("B14").Select
ActiveCell.FormulaR1C1 = "=COUNTA('Gestion tirage des câbles'!C[9])-1"
Range("B26").Select
ActiveCell.FormulaR1C1 = "=COUNTA('Gestion tirage des câbles'!C[13])-1"
End Sub
.........................................................................................................................
L'erreur se fait à chaque boucles FOR. Il me dit que l'indice n'appartient pas à la sélection pour ma variable Tableau3(). Si j'écris Tableau3(1,1) par exemple sa marche mais lorsque j'écris Tableau3(1, L) ou L serait la variable de la boucle FOR sa plante.
Si quelqu'un à une idée....
Je suis en train de faire un petit programme mais j'ai un léger problème au niveau de mes tableaux à deux dimensions.
Le code est le suivant:
..........................................................................................................................
Option Explicit
Sub Mise_a_Jour()
Dim LastLine1, LastLine2, LastLine3 As Integer
Dim I, J, K, L, M, N, O, P, Q As Integer
Dim CableTire As Double
Dim Valeur1 As String
Dim Tableau1(), Tableau2(), Tableau3(), Tableau4() As Variant
Dim Longueur_Theorique, Longueur_Posee, Longueur_Erreur, Buffer1, Buffer2, Buffer_Erreur As Variant
I = 1
J = 1
K = 1
L = 1
M = 1
N = 1
O = 1
P = 1
Q = 1
Longueur_Theorique = 0
Longueur_Posee = 0
Longueur_Erreur = 0
Buffer1 = 0
Buffer2 = 0
Buffer_Erreur = 0
'Activation de la feuille "Gestion Tourets"
Sheets("Gestion Tourets").Activate
'Recherche du numéro de la dernière ligne utilisée en colonne A
LastLine1 = Cells(Rows.Count, "A").End(xlUp).Row
'Suppression des lignes n'ayant pas un numéro de touret et des doublons
For I = LastLine1 To 1 Step -1
If Range("A" & I) = "" Then Rows(I).Delete
Next I
'Ordonnancement des tourets
Range("A1:G1").Select
ActiveWorkbook.Worksheets("Gestion Tourets").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Gestion Tourets").Sort.SortFields.Add Key:=Range( _
"A2:A648"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Gestion Tourets").Sort
.SetRange Range("A1:G648")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Suppression des doublons
Columns("A:G").Select
Range("G1").Activate
ActiveSheet.Range("$A$1:$G$49873").RemoveDuplicates Columns:=1, Header:= _
xlYes
'Recherche du numéro de la dernière ligne utilisée en colonne A et redimensionnement de Tableau1
LastLine1 = Cells(Rows.Count, "A").End(xlUp).Row
ReDim Tableau1(LastLine1)
'Copie de la liste des tourets dans Tableau1
For J = 2 To LastLine1 + 1
Tableau1(J - 1) = Range("A" & J)
Next J
'Activation de la feuille "Gestion tirage des câbles"
Sheets("Gestion tirage des câbles").Activate
'Recherche du numéro de la dernière ligne utilisée en colonne J et redimensionnement de Tableau2 et Tableau3
LastLine2 = Cells(Rows.Count, "J").End(xlUp).Row
ReDim Tableau2(LastLine2)
ReDim Tableau3(2, LastLine2)
'Copie de la liste des tourets dans Tableau1
For K = 3 To LastLine2 + 2
Tableau2(K - 2) = Range("J" & K)
Next K
'Calcul de la longueur utilisée sur chacun des tourets
For L = 3 To LastLine1 + 2
Longueur_Theorique = 0
Longueur_Posee = 0
For M = 3 To LastLine2 + 2
If Tableau1(L - 2) = Tableau2(M - 2) Then
Buffer1 = Range("H" & M)
Buffer2 = Range("I" & M)
Longueur_Theorique = Longueur_Theorique + Buffer1
Longueur_Posee = Longueur_Posee + Buffer2
Tableau3(0, L - 2) = Longueur_Theorique
Tableau3(1, L - 2) = Longueur_Posee
End If
Next M
Next L
'Activation de la feuille "Gestion des erreurs"
Sheets("Gestion des erreurs").Activate
'Ajout des longueurs des câbles tirés en erreur (doublon et mauvaise longueur)
LastLine3 = Cells(Rows.Count, "A").End(xlUp).Row
ReDim Tableau4(LastLine3)
For N = 3 To LastLine3 + 2
Tableau4(N - 2) = Range("J" & N)
Next N
For O = 3 To LastLine1 + 2
Longueur_Erreur = 0
For P = 3 To LastLine3 + 2
If Tableau1(O - 2) = Tableau4(P - 2) Then
Buffer_Erreur = Range("F" & P)
Longueur_Erreur = Longueur_Erreur + Buffer_Erreur
Tableau3(1, O - 2) = Tableau3(1, O - 2) + Longueur_Erreur
End If
Next P
Next O
'Activation de la feuille "Gestion Tourets"
Sheets("Gestion Tourets").Activate
'Insertion des longueurs calculées et calcul des longueurs restantes
For Q = 2 To LastLine1 + 1
Range("E" & Q) = Tableau3(0, Q - 1)
Range("F" & Q) = Tableau3(1, Q - 1)
Range("G" & Q).FormulaLocal = "=D" & Q & "-F" & Q
Next Q
'Activation de la feuille "Suivi du tirage de câble"
Sheets("Suivi du tirage de câble").Activate
'Mise en place des formules dans les cellules
Range("B2") = CableTire
Range("A2").Select
ActiveCell.FormulaR1C1 = "=SUM('Gestion tirage des câbles'!C[7])"
Range("A14").Select
ActiveCell.FormulaR1C1 = "=COUNTA('Gestion tirage des câbles'!C[2])-1"
Range("B14").Select
ActiveCell.FormulaR1C1 = "=COUNTA('Gestion tirage des câbles'!C[9])-1"
Range("B26").Select
ActiveCell.FormulaR1C1 = "=COUNTA('Gestion tirage des câbles'!C[13])-1"
End Sub
.........................................................................................................................
L'erreur se fait à chaque boucles FOR. Il me dit que l'indice n'appartient pas à la sélection pour ma variable Tableau3(). Si j'écris Tableau3(1,1) par exemple sa marche mais lorsque j'écris Tableau3(1, L) ou L serait la variable de la boucle FOR sa plante.
Si quelqu'un à une idée....