Bonjour,

J'ai un tableau de ce genre là : http://i.imgur.com/e36kd.png
Avec 6000 lignes.

J'ai plusieurs opérations à effectuer :
- Dans la colonne C et E, remplacer "a" par "b" et "c" par "d"
- Supprimer les lignes où la cellule de la colonne C est vide.
- Supprimer les lignes où la cellule de la colonne B vaut "S" et que la cellule de la colonne "H" vaut "x".
- Supprimer les lignes où la cellule de la colonne B vaut "A" et que la cellule juste en dessous ou juste au dessus vaut "S" et que les cellules des colonnes D,E et H soient les mêmes.
- Enfin supprimer les doublons sur toutes les colonnes.

J'ai fait ce programme :


Code : Sélectionner tout - Visualiser dans une fenêtre à part
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

Et là, c'est la cata. Toutes les lignes ne sont pas forcément balayées. Le traitement s'effectue sur certaines lignes et pas d'autres. Des lignes balayées ne sont pas traitées. Le seul truc qui fonctionne, c'est les doublons.

(Désolé pour les données, confidentielles.)

Donc je viens quérir votre aide, merci d'avances car je suis totalement perdu.