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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
| Sub TABLEAU_TRAITEMENT()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open("chemin\tableau.xls")
Set ws = wb.Worksheets(1)
Dim cellule_en_cours As String
Dim ligne As Integer
cellule_en_cours = "c"
ligne = 0
Do While cellule_en_cours <> ""
ligne = ligne + 1
cellule_en_cours = Cells(ligne, 1).Value
Loop
' On cherche la dernière ligne du tableau.
ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range("D2:D" & ligne), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range("A2:A" & ligne), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(1).Sort
.SetRange Range("A1:M" & ligne)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("A:M").EntireColumn.AutoFit
Range("A1:M" & ligne).Select
Selection.NumberFormat = "m/d/yyyy h:mm"
With Selection.Font
.Name = "Calibri"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' J'ai juste aligné à gauche, mis la bonne police, le bon format et ajusté la taille des colonnes.
Dim i As Integer
For i = 2 To ligne
Range("A" & i).Activate
Range("A" & i).Select
Cells(i, 14).Value = "Balayé"
' Pour voir par quelles lignes passe le programme.
If Cells(i, 3).Value = "a" Then
Cells(i, 3).Value = "b"
End If
If Cells(i, 3).Value = "c" Then
Cells(i, 3).Value = "d"
End If
If Cells(i, 5).Value = "a" Then
Cells(i, 5).Value = "b"
End If
If Cells(i, 5).Value = "c" Then
Cells(i, 5).Value = "d"
End If
If Cells(i, 2).Value = "A" Then
If Cells(i - 1, 2).Value = "S" And Cells(i - 1, 3).Value = Cells(i, 3).Value And Cells(i - 1, 4).Value = Cells(i, 4).Value And Cells(i - 1, 5).Value = Cells(i, 5).Value Then
Cells(i, 1).EntireRow.Delete
ligne = ligne - 1
End If
If Cells(i + 1, 2).Value = "S" And Cells(i + 1, 3).Value = Cells(i, 3).Value And Cells(i + 1, 4).Value = Cells(i, 4).Value And Cells(i + 1, 5).Value = Cells(i, 5).Value Then
Cells(i, 1).EntireRow.Delete
ligne = ligne - 1
End If
End If
If Cells(i, 8).Value = "x" Then
If Cells(i, 2).Value = "S" Then
Cells(i, 1).EntireRow.Delete
ligne = ligne - 1
End If
End If
If Cells(i, 3).Value = "" Then
Cells(i, 1).EntireRow.Delete
End If
Next
ActiveSheet.Range("$A$1:$N$" & ligne).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14), Header:=xlNo
ActiveCell(1, 1).Select
End Sub |
