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
| Sub Macro1()
Dim lastrow As String
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Columns("H:H").Select
Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 3), TrailingMinusNumbers:=True
ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort.SortFields.Add Key:=Range( _
"H1:H" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort.SortFields.Add Key:=Range( _
"B1:B" & lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("SNIF").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 1
Range("B" & i).Select
' Boucle tant que pas vide
Do While Not (IsEmpty(ActiveCell))
If Range("B" & i) = Range("B" & i + 1) Then
If Range("H" & i) = "***" Then
Rows(i).EntireRow.Delete Shift:=xlUp
Else
Rows(i + 1).EntireRow.Delete Shift:=xlUp
End If
Else
i = i + 1
End If
Range("B" & i).Select
Loop
End Sub |
Partager