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
|
Sub triededoublonne()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
'version sur plusieurs colones
On Error Resume Next
For i = 1 To Sheets("Feuil1").Range("A65536").End(xlUp).Row
NoDupes.Add Sheets("Feuil1").Range("A" & i) & ":" & Sheets("Feuil1").Range("B" & i), CStr(Sheets("Feuil1").Range("A" & i) & ":" & Sheets("Feuil1").Range("B" & i))
'
Next i
On Error GoTo 0
' On trie la collection
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
For i = 1 To NoDupes.Count
t = Split(NoDupes(i), ":")
Range("G" & i).Value = t(0)
Range("H" & i).Value = t(1)
Next i
End Sub |
Partager