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
| Sub Tableau()
Dim DerLig As Long, NbVal As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
DerLig = Columns("A:D").Find(what:="*", searchdirection:=xlPrevious).Row
NbVal = DerLig
'Defusionnage
Range("A2:D" & DerLig).MergeCells = False
For i = 2 To DerLig
If Cells(i, "A") <> "" Or Cells(i, "B") <> "" Or Cells(i, "C") <> "" Or Cells(i, "D") <> "" Then
If Cells(i, "A") = "" Then Cells(i, "A") = Cells(i - 1, "A")
If Cells(i, "B") = "" Then Cells(i, "B") = Cells(i - 1, "B")
If Cells(i, "C") = "" Then Cells(i, "C") = Cells(i - 1, "C")
If Cells(i, "D") = "" Then Cells(i, "D") = Cells(i - 1, "D")
End If
Next i
'Recopie des valeurs traitées en colonnes F à I
L = 2
For A = 2 To NbVal
For B = 2 To DerLig
For C = 2 To DerLig
For D = 2 To DerLig
Cells(L, "F") = Cells(A, "A")
Cells(L, "G") = Cells(B, "B")
Cells(L, "H") = Cells(C, "C")
Cells(L, "I") = Cells(D, "D")
L = L + 1
Next D
Next C
Next B
Next A
'Tri
DerLig = Columns("F").Find(what:="*", searchdirection:=xlPrevious).Row
Range("F2:I" & DerLig).Select
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("F2:F" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("G2:G" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("H2:H" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("I2:I" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("F1:I" & DerLig)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Suppression des doublons
For i = DerLig To 2 Step -1
If Cells(i, "F") = Cells(i - 1, "F") And Cells(i, "G") = Cells(i - 1, "G") And Cells(i, "H") = Cells(i - 1, "H") And Cells(i, "G") = Cells(i - 1, "G") Then Range(Cells(i, "F"), Cells(i, "I")).Delete
Next i
End Sub |
