1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
| Dim VALEUR1 As String, VALEUR2 As String
Dim VALEURA As String, VALEURB As String, VALEURC As String, VALEURD As String, VALEURE As String, VALEURF As String, n As Integer, p As Integer
Dim VALEURYE As String, VALEURYI As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 3 To 143
VALEUR1 = Range("D" & i).Value
VALEUR2 = Range("R" & i).Value
If VALEUR1 = "1" Then
Range("A" & i) = "*"
Else: Range("A" & i) = ""
End If
If VALEUR2 = "1" Then
Range("O" & i) = "*"
Else: Range("O" & i) = ""
End If
Next i
For j = 3 To 143
For k = 3 To 143
VALEURA = Range("I" & j).Value
VALEURC = Range("L" & j).Value
VALEURE = Range("A" & j).Value
VALEURB = Range("W" & k).Value
VALEURD = Range("Z" & k).Value
VALEURF = Range("O" & k).Value
If VALEURA = VALEURB And VALEURE = "*" And VALEURF = "*" Then
Range("C" & j) = "1"
Range("Q" & k) = "1"
End If
If VALEURC > VALEURD And VALEURE = "*" And VALEURF = "*" Then
Range("B" & j) = "1"
Range("P" & k) = "1"
End If
Next
Next
Application.Calculation = xlCalculationAutomatic
For l = 3 To 143
VALEURYE = Range("M" & l).Value
If VALEURYE = "Y" Then
Range(Cells(l, 4), Cells(l, 11)).Copy
Range(Cells(l, 31), Cells(l, 38)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End If
Next l
For m = 3 To 143
VALEURYI = Range("AA" & m).Value
If VALEURYI = "Y" Then
Range(Cells(m, 18), Cells(m, 25)).Copy
Range(Cells(m, 40), Cells(m, 47)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End If
Next m
Range("AE4:AL143").Sort Key1:=Range("AK4"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("AM4:AT143").Sort Key1:=Range("AS4"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveWindow.Visible = True
Application.ScreenUpdating = True
Set i = Nothing
Set j = Nothing
Set k = Nothing
Set l = Nothing
Set m = Nothing |
Partager