simplifier vba

[zumye]

bonjour le forum
quelqu'un serait me simplifier le programme vba qui suit, car la plus part des ligne se ressemble. merci

If xxx > num1 And xxx < num2 Or xxx > num1 And Range("ak14") = 1 Then
For ret = 1 To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If

If xxx > num2 And xxx < num3 Or xxx > num2 And Range("ak14") = 2 Then
For ret = 2 To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If

If xxx > num3 And xxx < num4 Or xxx > num3 And Range("ak14") = 3 Then
For ret = 3 To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If

If xxx > num4 And xxx < num5 Or xxx > num4 And Range("ak14") = 4 Then
For ret = 4 To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If

If xxx > num5 And xxx < num6 Or xxx > num5 And Range("ak14") = 5 Then
For ret = 5 To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If

If xxx > num6 And xxx < num7 Or xxx > num6 And Range("ak14") = 6 Then
For ret = 6 To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If

If xxx > num7 And xxx < num8 Or xxx > num7 And Range("ak14") = 7 Then
For ret = 7 To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If

If xxx > num8 And xxx < num9 Or xxx > num8 And Range("ak14") = 8 Then
For ret = 8 To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If

If xxx > num9 And xxx < num10 Or xxx > num9 And Range("ak14") = 9 Then
For ret = 9 To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If

If xxx > num10 And xxx < num11 Or xxx > num10 And Range("ak14") = 10 Then
For ret = 10 To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If

If xxx > num11 And xxx < num12 Or xxx > num11 And Range("ak14") = 11 Then
For ret = 11 To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If

 

[Denis]

Re : simplifier vba

Bonjour Zumie et le Forum
il te faut créer un Array pour remplacer num1,2 etc

Dim Num, i%
Num = Array(num1 , num2 , num3 , num4 , num5 , num6 , num7 , num8 , num9 , num10 , num11)

For i = 1 to 11
If xxx > Num(i) And xxx < Num(i + 1) Or xxx > Num(i) And Range("ak14") = i Then
For ret = 1 To 11
Range("ak" & ret) = Range("ak" & ret) + 1 ' ici je pense qu'il y a un pb
' ne serait ce pas : Range("ak" & ret) = Range("ak" & ret + 1)
' à vérifier !
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If
Next

Bon courage et à +

 

[pierrejean]

Re : simplifier vba

Re
Il serait possible de simplifier si tes variables num etait dans un tableau (genre nums())
Comment leurs valeurs sont elles attribuées ?

 

[mécano41]

Re : simplifier vba

Bonjour,

Denis : Il me semble que ça va coincer à i=11, il va chercher num12 dans l'array qui n'en comporte que 11...

Cordialement

 

[zumye]

Re : simplifier vba

rebonjour , voila comment les num sont attribué

ligne = 17
For ligne = ligne To findeligne
If Range("b" & ligne) = 1 Then num1 = ligne
If Range("b" & ligne) = 2 Then num2 = ligne
If Range("b" & ligne) = 3 Then num3 = ligne
If Range("b" & ligne) = 4 Then num4 = ligne
If Range("b" & ligne) = 5 Then num5 = ligne
If Range("b" & ligne) = 6 Then num6 = ligne
If Range("b" & ligne) = 7 Then num7 = ligne
If Range("b" & ligne) = 8 Then num8 = ligne
If Range("b" & ligne) = 9 Then num9 = ligne
If Range("b" & ligne) = 10 Then num10 = ligne
If Range("b" & ligne) = 11 Then num11 = ligne
Next

 

[Denis]

Re : simplifier vba

Bonjour le fil et le Forum
exact Mecano, j'ai oublié le num12 à ajouter dans l'array
autant pour moi
à +
Denis

 

[zumye]

Re : simplifier vba

je rajoute egalement ceci car tout commence par la
suite a un double clic dans la colonne 8

ElseIf Target.Column = 8 And Target.Row > 20 And Target.Row < 3000 Then
ActiveSheet.Unprotect
xxx = ActiveCell.Row

Range("bc1").Select
Selection.End(xlDown).Select
findeligne = ActiveCell.Row

 

[zumye]

Re : simplifier vba

bonjour denis
non c'est bien ca
Range("ak" & ret) = Range("ak" & ret) + 1
la valeur dans la cellule augmente de 1

 

[pierrejean]

Re : simplifier vba

Re

A tester:

Dim num(1 To 11)
ligne = 17
For ligne = ligne To findeligne
If Range("b" & ligne) = 1 Then num(1) = ligne
If Range("b" & ligne) = 2 Then num(2) = ligne
If Range("b" & ligne) = 3 Then num(3) = ligne
If Range("b" & ligne) = 4 Then num(4) = ligne
If Range("b" & ligne) = 5 Then num(5) = ligne
If Range("b" & ligne) = 6 Then num(6) = ligne
If Range("b" & ligne) = 7 Then num(7) = ligne
If Range("b" & ligne) = 8 Then num(8) = ligne
If Range("b" & ligne) = 9 Then num(9) = ligne
If Range("b" & ligne) = 10 Then num(10) = ligne
If Range("b" & ligne) = 11 Then num(11) = ligne
Next
For n = 1 To 10
If xxx > num(n) And xxx < num(n + 1) Or xxx > num(1) And Range("ak14") = 1 Then
For ret = n To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If
Next n

 

[zumye]

Re : simplifier vba

MERCI PIERRE JEAN
ca marche, sauf une petite modif a faire que je chercherai plus tard

 

[Denis]

Re : simplifier vba

Re leFil
Allez PierreJean, on rajoute une boucle ! LOL
Dim num(1 To 11)
findeligne = Range("bc65536").End(xlDown).Row
ligne = 17

For ligne = ligne To findeligne
For i = 1 to 11 'ou 12
If Range("b" & ligne) = 1 Then num(i) = ligne
Next
Next

For n = 1 To 10 'ou 11
If xxx > num(n) And xxx < num(n + 1) Or xxx > num(1) And Range("ak14") = 1 Then
For ret = n To 11
Range("ak" & ret) = Range("ak" & ret) + 1
If Range("ak" & ret + 1) = "" Then Exit For
Next
End If
Next n

à +
Denis