Patrick, j'ai constaté le même problème que toi ! Et pendant que je repartais de ma version
tu as bien cerné le problème du tri sur F:G au lieu de F:H comme Ryu dans le post #162 (
) …
Comme je teste avec une version 2003, je suis limité à 65 536 lignes et voici donc mon code d'initialisation
(dans celui de Franck du post #126 il faut inverser les
ScreenUpdating !) :
1
2
3
4
5
6
7
8
9
10
11
12
13
| Sub Initialisation()
Const N = 65535
Dim C&, R&, S$(N, 4)
Randomize 666.666
ActiveSheet.UsedRange.Clear
[I1].Select
For R = 0 To N
For C = 0 To 4: S(R, C) = Chr$((5 * Rnd) + 65): Next
Next
Application.ScreenUpdating = False
[A1].Resize(N + 1, 5).Value = S
Application.ScreenUpdating = True
End Sub |
Voici le code d'Unparia (déclenchant une erreur s'il n'y a pas de doublon) à ma sauce
s'exécutant de mon côté en 2,667s pour les 65 536 lignes :
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
| Sub TriDoublonsUnparia()
Dim T!, pl_doublons As Range
T = Timer
Application.ScreenUpdating = False
With ActiveSheet.UsedRange.Resize(, 8).Columns
.Item(6).Formula = "=A1&""¤""&B1&""¤""&C1&""¤""&D1&""¤""&E1"
.Item(7).Formula = "=ROW()"
With .Item("F:G")
.Formula = .Value
.Sort .Cells(1), xlAscending, Header:=xlNo
End With
.Cells(8).Value = 0
With .Item(8).Rows("2:" & .Rows.Count)
.Formula = "=IF(F2=F1,"""",F2)"
.Formula = .Value
End With
.Item("F:H").Sort .Cells(7), xlAscending, Header:=xlNo
Set pl_doublons = .Item(8).SpecialCells(xlCellTypeBlanks)
Application.ScreenUpdating = True
MsgBox Format(Timer - T, "0.000s") & " pour traiter " & .Rows.Count & " lignes de 5 colonnes" & _
vbLf & vbLf & "et extraire la plage " & pl_doublons.Address(0, 0)
.Item("F:H").Clear
End With
pl_doublons.EntireRow.Select
Set pl_doublons = Nothing
End Sub |
Mettre la ligne de code n°22 en commentaire pour contrôler …
J'ai modifié le séparateur dans la formule (ligne n°6) afin de pouvoir effectuer un contrôle via la recherche d'Excel.
Et je gagne une bonne seconde comme je l'ai déjà posté plusieurs fois notamment lors de l'accompagnement initiatique de Ryu
en plaçant les doublons à la fin en vue de les supprimer par exemple, ici tout en conservant
l'ordre des uniques (ligne n°17), sans erreur s'il n'y a pas de doublon,
le traitement est réduit à 1,436s :
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
| Sub TriDoublons()
Dim T!, pl_doublons As Range, S$
T = Timer
Application.ScreenUpdating = False
With ActiveSheet.UsedRange.Resize(, 8).Columns
.Item(6).Formula = "=A1&""¤""&B1&""¤""&C1&""¤""&D1&""¤""&E1"
.Item(7).Formula = "=ROW()"
With .Item("F:G")
.Formula = .Value
.Sort .Cells(1), xlAscending, Header:=xlNo
End With
.Cells(8).Value = 0
With .Item(8).Rows("2:" & .Rows.Count)
.Formula = "=IF(F2=F1,1,0)"
.Formula = .Value
End With
.Item("F:H").Sort .Cells(7), xlAscending
.Sort .Cells(8), xlAscending
S = " pour traiter " & .Rows.Count & " lignes de 5 colonnes"
Set pl_doublons = .Item(8).Find(1)
If Not pl_doublons Is Nothing Then
Set pl_doublons = .Rows(pl_doublons.Row & ":" & .Rows.Count).Resize(, 5)
S = S & vbLf & vbLf & "et extraire la plage " & pl_doublons.Address(0, 0)
End If
Application.ScreenUpdating = True
MsgBox Format(Timer - T, "0.000s") & S
.Item("F:H").Clear
End With
If Not pl_doublons Is Nothing Then pl_doublons.Clear: Set pl_doublons = Nothing
End Sub |
Temps équivalent sans se préoccuper de l'ordre initial mais avec la suppression directe des doublons comprise :
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
| Sub SuppressionDoublons()
Dim T!, Rg As Range, S$
T = Timer
Application.ScreenUpdating = False
With ActiveSheet.UsedRange.Resize(, 8).Columns
.Item(6).Formula = "=A1&""¤""&B1&""¤""&C1&""¤""&D1&""¤""&E1"
.Item(7).Formula = "=ROW()"
.Item("F:G").Formula = .Item("F:G").Value
.Sort .Cells(6), xlAscending, Header:=xlNo
.Cells(8).Value = 0
With .Item(8).Rows("2:" & .Rows.Count)
.Formula = "=IF(F2=F1,1,0)"
.Formula = .Value
End With
.Item("F:H").Sort .Cells(7), xlAscending
.Sort .Cells(8), xlAscending
S = " pour traiter " & .Rows.Count & " lignes de 5 colonnes"
Set Rg = .Item(8).Find(1)
If Not Rg Is Nothing Then
.Rows(Rg.Row & ":" & .Rows.Count).Clear
Set Rg = Nothing
S = S & vbLf & vbLf & "et supprimer les doublons."
End If
.Item("F:H").Clear
Application.ScreenUpdating = True
MsgBox Format(Timer - T, "0.000s") & S
End With
End Sub |
_________________________________________________________________________________________________________
L’important, le principal, est de savoir ce qu’il faut observer. (Edgar Allan Poe)
re
: ça peut servir aux autres 
pour aller plus vite, je vais devenir extrêmement curieux 
Envoyé par Marc-L
Partager