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 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
|
Dim nom As String
Dim nom2 As String
nom = Sheets(1).Name
nom2 = Sheets(2).Name
Sheets(nom).Activate
Range("A18000").End(xlUp).Select
Dim j As Integer
j = ActiveCell.Row
If j >= 6 Then
Range("A6", "H" & j).Select
Range("A6", "H" & j).Interior.Color = RGB(250, 250, 250)
Selection.ClearContents
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
End If
' lancement du trie
Dim rayon As Integer
Dim nbr_tb As Integer
Dim nbr As Integer
Dim stock_t As Currency
Dim nbr_lig As Integer
Sheets(nom2).Activate
Range("A30000").End(xlUp).Select
nbr_lig = ActiveCell.Row + 1
nbr = 2
Cells(nbr, 1).Select
rayon = Mid(Cells(nbr, 1), 1, 1)
nbr_tb = 6
Sheets(nom).Range("C1").Value = "R" & rayon & "0"
Do While Cells(nbr, 1) <> ""
If Cells(nbr, 31) > 0 Then
Sheets(nom).Range("A" & nbr_tb).Value = Cells(nbr, 1)
Range("B" & nbr).Copy _
Sheets(nom).Range("B" & nbr_tb)
Range("I" & nbr).Copy _
Sheets(nom).Range("C" & nbr_tb)
Range("AE" & nbr).Copy _
Sheets(nom).Range("D" & nbr_tb)
Range("AK" & nbr).Copy _
Sheets(nom).Range("E" & nbr_tb)
Sheets(nom).Range("F" & nbr_tb).Value = Sheets(nom).Range("D" & nbr_tb) * Sheets(nom).Range("E" & nbr_tb)
Range("M" & nbr).Copy _
Sheets(nom).Range("G" & nbr_tb)
Sheets(nom).Range("H" & nbr_tb).Value = (Range("M" & nbr) + Range("N" & nbr) + Range("O" & nbr) + Range("P" & nbr) + Range("Q" & nbr) + Range("R" & nbr) + Range("S" & nbr) + Range("T" & nbr) + Range("U" & nbr) + Range("V" & nbr) + Range("W" & nbr) + Range("X" & nbr)) / 12
If Sheets(nom).Cells(nbr_tb, 4) > (2 * Sheets(nom).Cells(nbr_tb, 8)) Then
Sheets(nom).Cells(nbr_tb, 4).Interior.Color = RGB(250, 0, 0)
End If
nbr_tb = nbr_tb + 1
End If
nbr = nbr + 1
Loop
Sheets(nom).Activate
Range("A6:I" & nbr_tb).Sort Key1:=Range("F6"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A30000").End(xlUp).Select
j = ActiveCell.Row
Range("A6", "H" & j).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(("B6"), Range("B6").End(xlDown)).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Range(("F6"), Range("F6").End(xlDown)).Select
Selection.Font.Bold = True
Range("A5").Select |
Partager