Validation des données avec VBA

Fermé
hajar1504 Messages postés 2 Date d'inscription mardi 20 août 2013 Statut Membre Dernière intervention 26 août 2013 - 26 août 2013 à 19:54
Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 - 27 août 2013 à 08:05
Bonjour,

j'ai besoin d'une macro pour la validations de données et calcule de temps de soudage.
la macro doit parcourir la première colonne jusqu'à le changement de la référence de point de soudage. ainsi que calculer le nombre de fils à droite et à gauche (colonne B et C) et aussi extraire la longueur du fil de chaque référence.
j ai déjà commencer la programmation mais ça me donne une boucle infini

Sub valider()
'
' Macro1 Macro
'
Dim l
l = 1
While Range("A" & l) <> ""
Dim i, j, k, m, n, c
Dim lng1, lng2, lng3, lng4, lng5, lnd1, lnd2, lnd3, lnd4, lnd5
m = 0
n = 0
i = 2
c = i
j = l
k = l
o = i
p = i
If Range("A" & i + 1) = Range("A" & i) Then
i = i + 1
End If

'--- calcul du nombre de fil côté gauche ---
Do Until Range("b" & o) = "" 'And o < i
m = m + 1
o = o + 1
Loop

'--- calcul du nombre de fil côté droit ---
Do Until Range("b" & p) = "" 'And p < i
n = n + 1
p = p + 1
Loop


'----------------------------- calcul des temps -------------------------------------
'cas 1 : pour le cas ou les longeurs gauches et droites inferieurs a 100cm


lng1 = Mid(Range("B" & c), 5, 2)
lng2 = Mid(Range("B" & c + 1), 5, 2)
lng3 = Mid(Range("B" & c + 2), 5, 2)
lng4 = Mid(Range("B" & c + 3), 5, 2)
lng5 = Mid(Range("B" & c + 4), 5, 2)

lnd1 = Mid(Range("C" & k), 5, 2)
lnd2 = Mid(Range("C" & k + 1), 5, 2)
lnd3 = Mid(Range("C" & k + 2), 5, 2)
lnd4 = Mid(Range("C" & k + 3), 5, 2)
lnd5 = Mid(Range("C" & k + 4), 5, 2)


If lng1 < 100 And lng2 < 100 And lng3 < 100 And lng4 < 100 And lng5 < 100 And lnd1 < 100 And lnd2 < 100 And lnd3 < 100 And lnd4 < 100 And lnd5 < 100 Then

If m + n = 2 Then
Range("D" & p) = 15

ElseIf m + n = 3 Then
Range("D" & p) = 22.5

ElseIf m + n = 4 Then
Range("D" & p) = 30


ElseIf m + n = 5 Then
Range("D" & p) = 37.5

ElseIf m + n = 6 Then
Range("D" & p) = 45

ElseIf m + n = 7 Then
Range("D" & p) = 52.5

ElseIf m + n = 8 Then
Range("D" & p) = 60

End If
End If

' fin cas 1
'--------------------------------
' cas 2 : pour le cas ou les longeurs gauches et droites supérieurs a 100cm
If (lng1 > 100 Or lng2 > 100 Or lng3 > 100 Or lng4 > 100 Or lng5 > 100) And (lnd1 > 100 Or lnd2 > 100 Or lnd3 > 100 Or lnd4 > 100 Or lnd5 > 100) Then

Dim X1
Dim X2
Dim t1 As Double
Dim te1 As Double
Dim t2 As Double
Dim te2 As Double
Dim t3 As Double
Dim te3 As Double

If m + n = 2 Then
t1 = 12.5

ElseIf m + n = 3 Then
t1 = 22.5

ElseIf m + n = 4 Then
t1 = 30

ElseIf m + n = 5 Then
t1 = 37.5

ElseIf m + n = 6 Then
t1 = 45

ElseIf m + n = 7 Then
t1 = 52.5

ElseIf m + n = 8 Then
t1 = 60

End If

te1 = t1
' calcul du max
Dim b1, b2
Static Z1, Z2, Z3, Z4, Z5
Static W1, W2, W3, W4, W5
y1 = Array(Z1, Z2, Z3, Z4, Z5)
y2 = Array(W1, W2, W3, W4, W5)
Z1 = lng1
Z2 = lng2
Z3 = lng3
Z4 = lng4
Z5 = lng5

W1 = lnd1
W2 = lnd2
W3 = lnd3
W4 = lnd4
W5 = lnd5


X1 = 0
For b2 = 0 To 4
If (y1(b2) >= X1) Then X1 = y1(b2)
Next b2

X2 = 0
For b1 = 0 To 4
If (y2(b1) >= X2) Then X2 = y2(b1)
Next b1
' fin du calcul du max
End If



If X1 > 100 And X2 > 100 Then

If 100 < X1 And X1 <= 140 Then

t2 = 14.4

ElseIf 140 < X1 And X1 <= 200 Then
t2 = 16

ElseIf 200 < X1 And X1 <= 260 Then
t2 = 17.6

ElseIf 260 < X1 And X1 <= 320 Then
t2 = 19.2

ElseIf 320 < X1 And X1 <= 380 Then
t2 = 20.8

ElseIf 380 < X1 And X1 <= 440 Then
t2 = 22.4

ElseIf 440 < X1 And X1 <= 500 Then
t2 = 24

ElseIf 500 < X1 And X1 <= 560 Then
t2 = 25.6

ElseIf 560 < X1 And X1 <= 620 Then
t2 = 27.2

ElseIf 620 < X1 And X1 <= 680 Then
t2 = 28.8

ElseIf 680 < X1 And X1 <= 740 Then
t2 = 30.4

ElseIf 740 < X1 And X1 <= 800 Then
t2 = 32

End If

te2 = t2


If 100 < X2 And X2 <= 140 Then
t3 = 14.4

ElseIf 140 < X2 And X2 <= 200 Then
t3 = 16

ElseIf 200 < X2 And X2 <= 260 Then
t3 = 17.6

ElseIf 260 < X2 And X2 <= 320 Then
t3 = 19.2

ElseIf 320 < X2 And X2 <= 380 Then
t3 = 20.8

ElseIf 380 < X2 And X2 <= 440 Then
t3 = 22.4

ElseIf 440 < X2 And X2 <= 500 Then
t3 = 24

ElseIf 500 < X2 And X2 <= 560 Then
t3 = 25.6

ElseIf 560 < X2 And X2 <= 620 Then
t3 = 27.2

ElseIf 620 < X2 And X2 <= 680 Then
t3 = 28.8

ElseIf 680 < X2 And X2 <= 740 Then
t3 = 30.4

ElseIf 740 < X2 And X2 <= 800 Then
t3 = 32

End If


te3 = t3

Range("D" & p) = te1 + te2 + te3
End If

' fin cas 2

' cas 3 : un des deux cotés est sup a 100cm
' coté gauche
If (lng1 > 100 Or lng2 > 100 Or lng3 > 100 Or lng4 > 100 Or lng5 > 100) And (lnd1 < 100 And lnd2 < 100 And lnd3 < 100 And lnd4 < 100 And lnd5 < 100) Then

Dim X11 As Double
Dim t11 As Double
Dim te11 As Double
Dim t22 As Double
Dim te22 As Double

'----------------------------------------------------------------
If m + n = 2 Then
t11 = 12.5

ElseIf m + n = 3 Then
t11 = 22.5

ElseIf m + n = 4 Then
t11 = 30

ElseIf m + n = 5 Then
t11 = 37.5

ElseIf m + n = 6 Then
t11 = 45

ElseIf m + n = 7 Then
t11 = 52.5

ElseIf m + n = 8 Then
t11 = 60

End If
'---------------------------------------------------------------
te11 = t11
' calcul du max

Static Z11, Z22, Z33, Z44, Z55

y11 = Array(Z11, Z22, Z33, Z44, Z55)

Z11 = lng1
Z22 = lng2
Z33 = lng3
Z44 = lng4
Z55 = lng5

X11 = 0
For b2 = 0 To 4
If (y11(b2) >= X11) Then X11 = y11(b2)
Next b2

' fin du calcul du max
'End If
'-----------------------------------------------
If 100 < X11 And X11 <= 140 Then

t22 = 14.4

ElseIf 140 < X11 And X11 <= 200 Then
t22 = 16

ElseIf 200 < X11 And X11 <= 260 Then
t22 = 17.6

ElseIf 260 < X11 And X11 <= 320 Then
t22 = 19.2

ElseIf 320 < X11 And X11 <= 380 Then
t22 = 20.8

ElseIf 380 < X11 And X11 <= 440 Then
t22 = 22.4

ElseIf 440 < X11 And X11 <= 500 Then
t22 = 24

ElseIf 500 < X11 And X11 <= 560 Then
t22 = 25.6

ElseIf 560 < X11 And X11 <= 620 Then
t22 = 27.2

ElseIf 620 < X11 And X11 <= 680 Then
t22 = 28.8

ElseIf 680 < X11 And X11 <= 740 Then
t22 = 30.4

ElseIf 740 < X11 And X11 <= 800 Then
t22 = 32

End If
'------------------------------------------------------------
te22 = t22

Range("D" & p) = te11 + te22
End If
' coté droite
If (lng1 < 100 And lng2 < 100 And lng3 < 100 And lng4 < 100 And lng5 < 100) And (lnd1 > 100 Or lnd2 > 100 Or lnd3 > 100 Or lnd4 > 100 Or lnd5 > 100) Then

Dim X22 As Double
Dim t12 As Double
Dim te12 As Double
Dim t33 As Double
Dim te33 As Double

'----------------------------------------------------------------
If m + n = 2 Then
t12 = 12.5

ElseIf m + n = 3 Then
t12 = 22.5

ElseIf m + n = 4 Then
t12 = 30

ElseIf m + n = 5 Then
t12 = 37.5

ElseIf m + n = 6 Then
t12 = 45

ElseIf m + n = 7 Then
t12 = 52.5

ElseIf m + n = 8 Then
t12 = 60

End If
'---------------------------------------------------------------
' calcul du max

Static W11, W22, W33, W44, W55

y22 = Array(W11, W22, W33, W44, W55)

W11 = lnd1
W22 = lnd2
W33 = lnd3
W44 = lnd4
W55 = lnd5

X22 = 0
For b2 = 0 To 4
If (y22(b2) >= X22) Then X22 = y22(b2)
Next b2

' fin du calcul du max
' End If
'-----------------------------------------------
If 100 < X22 And X22 <= 140 Then

t33 = 14.4

ElseIf 140 < X22 And X22 <= 200 Then
t33 = 16

ElseIf 200 < X22 And X22 <= 260 Then
t33 = 17.6

ElseIf 260 < X22 And X22 <= 320 Then
t33 = 19.2

ElseIf 320 < X22 And X22 <= 380 Then
t33 = 20.8

ElseIf 380 < X22 And X22 <= 440 Then
t33 = 22.4

ElseIf 440 < X22 And X22 <= 500 Then
t33 = 24

ElseIf 500 < X22 And X22 <= 560 Then
t33 = 25.6

ElseIf 560 < X22 And X22 <= 620 Then
t33 = 27.2

ElseIf 620 < X22 And X22 <= 680 Then
t33 = 28.8

ElseIf 680 < X22 And X22 <= 740 Then
t33 = 30.4

ElseIf 740 < X22 And X22 <= 800 Then
t33 = 32

End If
'------------------------------------------------------------


Range("D" & p) = t12 + t33
End If


' fin cas 3
l = l + 1

Wend
'
End Sub


3 réponses

Le Pingou Messages postés 12187 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 14 novembre 2024 1 449
26 août 2013 à 23:23
Bonjour,
Comment voulez-vous que l'on trouve ou vous avez une boucle infinie sans voir votre fichier... ?
Certainement pas en lisant votre code... !

0
hajar1504 Messages postés 2 Date d'inscription mardi 20 août 2013 Statut Membre Dernière intervention 26 août 2013
26 août 2013 à 23:44
bonjour,
je m'excuse je suis nouvelle ici ^^ (et je ne sais pas comment attacher un fichier)
0
Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 523
27 août 2013 à 08:05
0