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
|
Sub Resultat()
Dim c As Object, ligne As Long, code As String, prix As Long
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("F:F") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("L:L") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("A:M")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
With ActiveWorkbook.Worksheets("Feuil1")
ligne = 2: n = 1
code = .Cells(ligne, 3) & .Cells(ligne, 4) & .Cells(ligne, 5) & .Cells(ligne, 6)
Do Until .Cells(ligne, 5) = ""
If code = .Cells(ligne, 3) & .Cells(ligne, 4) & .Cells(ligne, 5) & .Cells(ligne, 6) Then
.Cells(ligne, 13) = n
Else
code = .Cells(ligne, 3) & .Cells(ligne, 4) & .Cells(ligne, 5) & .Cells(ligne, 6)
n = 1
.Cells(ligne, 13) = n
End If
n = n + 1
ligne = ligne + 1
Loop
End With
End Sub |
Partager