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
|
Sub triage()
Dim cptc As Long
Dim cptx As Long
Dim x As Long
x = 2
y = 2
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks("national.xlsm").Worksheets("Feuil1").Activate
Cells(1, 1).Select
cptc = Cells.SpecialCells(xlCellTypeLastCell).Row
Range("a2:e" & cptc).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("E2") _
, Order2:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers, DataOption3 _
:=xlSortNormal
Cells(1, 8).Value = "nb"
Cells(1, 7).Value = "tee"
Cells(1, 6).Value = "ETS"
While x < cptc
If Cells(x, 4) = "" Or Cells(x, 2) = "" Or Cells(x, 3) = "" Or Cells(x, 1) = "Commande de prélèvement" Then
Cells(x, 1).EntireRow.Select
Cells(x, 1).EntireRow.Delete
x = x - 1
cptc = cptc - 1
End If
If Cells(x, 1) = Cells(x + 1, 1) Then
Cells(x, 1).EntireRow.Select
Cells(x, 1).EntireRow.Delete
x = x - 1
cptc = cptc - 1
End If
x = x + 1
Wend
'Cells(x, 11).FormulaLocal = formule
''''''''''''''''''''''''''''''
ActiveWorkbook.Save
Cells(1, 1).Select
cptx = Cells.SpecialCells(xlCellTypeLastCell).Row
While y < cptx
formule = "=GAUCHE(DROITE(D" & y & ";5);3)"
formule2 = "=SI(NBCAR(D" & y & ")=7;GAUCHE(D" & y & ";1);GAUCHE(D" & y & ";2))"
Range("H" & y) = 1
Range("G" & y).FormulaLocal = formule
Range("F" & y).FormulaLocal = formule2
y = y + 1
Wend
Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub |
Partager