Encore une simplification de code

[anber]

Bonjour le forum

Encore une demande de simplification de code


Dim Feuilles() As Variant
Dim cptcol As Integer
Dim CptLigne As Integer
Dim CptFeuil As Byte

For CptFeuil = 0 To UBound(Feuilles)
With Sheets(Feuilles(CptFeuil))
.Range("N6T65536").ClearContents
Ligne = .Range("A65536").End(xlUp).Row
If Ligne <> 1 Then
For cptcol = 14 To 101
For CptLigne = 8 To Ligne
If RTrim(.Range("F" & CptLigne)) = .Cells(5, cptcol) Then
.Cells(6, cptcol) = Round(.Cells(6, cptcol) + ((.Range("E" & CptLigne) * .Range("L" & CptLigne)) / 1000), 4)
End If
Next
Next
For cptcol = 102 To 108
For CptLigne = 8 To Ligne
If RTrim(.Range("A" & CptLigne)) = .Cells(5, cptcol) Then
.Cells(6, cptcol) = Round(.Cells(6, cptcol) + ((.Range("E" & CptLigne) * .Range("L" & CptLigne)) / 1000), 4)
End If
Next
Next
For cptcol = 109 To 114
For CptLigne = 8 To Ligne
If RTrim(.Range("A" & CptLigne)) = .Cells(2, cptcol) Then
If .Range("D" & CptLigne) = .Cells(3, cptcol) And .Range("C" & CptLigne) = .Cells(4, cptcol) Then
.Cells(6, cptcol) = Round(.Cells(6, cptcol) + ((.Range("E" & CptLigne) * .Range("L" & CptLigne)) / 1000), 4)
End If
End If
Next
Next

For cptcol = 115 To 118
For CptLigne = 8 To Ligne
If RTrim(.Range("A" & CptLigne)) = .Cells(3, cptcol) Then
If .Range("D" & CptLigne) = .Cells(4, cptcol) Then
.Cells(6, cptcol) = Round(.Cells(6, cptcol) + ((.Range("E" & CptLigne) * .Range("L" & CptLigne)) / 1000), 4)
If .Range("C" & CptLigne) = .Cells(5, cptcol) Then
.Cells(6, cptcol) = Round(.Cells(6, cptcol) + ((.Range("E" & CptLigne) * .Range("L" & CptLigne)) / 1000), 4)
End If
End If
End If
Next
Next

For cptcol = 119 To 119

For CptLigne = 8 To Ligne
If RTrim(.Range("A" & CptLigne)) <> "PX" Then
.Cells(6, cptcol) = Round(.Cells(6, cptcol) + ((.Range("C" & CptLigne) * .Range("D" & CptLigne) * .Range("L" & CptLigne) * 10) / 1000000000), 5)
End If
Next
Next

For cptcol = 120 To 120
For CptLigne = 8 To Ligne
If RTrim(.Range("A" & CptLigne)) <> "PX" Then
.Cells(6, cptcol) = Round(.Cells(6, cptcol) + ((.Range("L" & CptLigne) * 10) / 1000), 4)
End If
Next
Next
For cptcol = 121 To 122
For CptLigne = 8 To Ligne
If RTrim(.Range("A" & CptLigne)) = .Cells(3, cptcol) And .Range("D" & CptLigne) = .Cells(4, cptcol) Then
.Cells(6, cptcol) = Round(.Cells(6, cptcol) + ((.Range("E" & CptLigne) * .Range("F" & CptLigne)) / 1000), 4)
End If
Next
Next
For cptcol = 123 To 123
For CptLigne = 8 To Ligne
If RTrim(.Range("A" & CptLigne)) = .Cells(3, cptcol) And .Range("D" & CptLigne) < .Cells(4, 122) Then
.Cells(6, cptcol) = Round(.Cells(6, cptcol) + ((.Range("E" & CptLigne) * .Range("F" & CptLigne)) / 1000), 4)
End If
Next
Next
For cptcol = 124 To 124
For CptLigne = 8 To Ligne
If RTrim(.Range("A" & CptLigne)) = .Cells(3, cptcol) Then
.Cells(6, cptcol) = Round(.Cells(6, cptcol) + ((.Range("E" & CptLigne) * .Range("F" & CptLigne)) / 1000), 4)
End If
Next
Next

End If

End With
Next

Merci

 

[G.David]

Salut
a premiere vue (attends que j'essuie mes lunettes)
tu as tois boucles For....to... next inutiles
cptool=120
cptool=123
cptool=124
pour le reste sans connaitre la structure de tes données je ne vois pas à deuxieme vue ce qui peut etre regroupés
Cordialement
G.David