Bonjour à tous,
J'ai fait en VBA un programme pour vérifier si un "conte", une colonne de cellules entre 20 et 30, se retrouvent dans un "code", une autre colonne d'environ 3500 cellules. Lorsqu'il y en a plus de 5 qui s'y retrouve, le programme écrit les séquences et les colorie sur les colonnes à côté, sinon il efface la sélection. Une fois trouvé toutes les plages de cellules, ils passent à la feuille suivante.
Lorsqu'il arrive aux 4 dernières cellules, je demande à ce qu'il ne les vérifie pas (là il me semble que j'ai un problème).

Le programme fonctionne mais il n'est pas rapide et il bloque quand le conte est trop grand.
Je n'ai pas encore compris comment utiliser les tableaux alors j'ai fait avec les moyens du bord.
Si l'un de vous pouvez y jeter un œil pour me dire comment le simplifier ?
J'ai réduit la colonne "code" à une soixantaine de cellules à titre de test.
Voici le fichier :
et le code :

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
Sub Conte_2()
Dim FL1 As Worksheet, Cell As Range, Code As Integer, Conte As Long
Dim DerLig As Long, Zone As Range
Dim adres As String, NoLig As Long, Var, Ecrit, NoCol As Integer
 
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    'Instance de la feuille : Permet d'utiliser FL1 partout dans ...
    '... le code à la place de Worksheets("Conte2")
    Set FL1 = ActiveSheet
    'Fixe le N° de première colonne de la plage à lire
    Code = 5
    'Fixe le N° de la dernière colonne de la plage à lire
    Conte = 2
    ' Ecrit écrémente la colonne d'écriture
    Ecrit = 1
    'Détermine la dernière ligne renseignée de la feuille de calculs
    DerLig = Split(FL1.UsedRange.Address, "$")(4)
 
    With FL1
        Set Zone = .Range(FL1.Cells(5, Code), FL1.Cells(DerLig, Code))
        'Utilisation de l'objet range (Cell) dans une boucle For Each... Next
        For Each Cell In Zone
        ' i écrémente la ligne de la colonne Conte34
        For i = 5 To DerLig
        ' j écrémente la ligne de la colonne Code
        ' Var écrémente j
        For j = 5 To DerLig
                'Si cellule code = cellule conte et que la valeur est différente de XYX
                If Cells(j, Code).Value = Cells(i, Conte).Value And Cells(j, Code).Value <> "XYX" Then
 
                Var = 0
                'tant que code est inférieur à conte
                    Do While Var < WorksheetFunction.CountA(FL1.Columns(2))
 
                        If Cells(j + Var, Code).Value = Cells(i + Var, Conte).Value Then
                            'sélectionner la cellule dessous
                            Cells(j + Var, Code).Select
                            'écrire la lettre dans la cellule
                            ActiveCell.Offset(0, Ecrit).Value = Cells(j + Var, Code)
                            'colorier la cellule
                            ActiveCell.Offset(0, Ecrit).Interior.Color = Cells(i + Var, Conte).Interior.Color
                        Else
                            'efface les groupes de cellules inférieur à 6
                            If Var < 5 Then
                            Var = Var - 1
                            Range(ActiveCell.Offset(0, Ecrit), ActiveCell.Offset(-Var, Ecrit)).Clear
                            End If
                            j = j + Var
                            Exit Do
                        End If
                    Var = Var + 1
                    Loop
 
                End If
                'si c'est la fin de code
                If Cells(j, Code).Value = "XYX" Then
                'colonne suivante
                i = i + 1
                'retour en début de ligne et le compteur rajoute 1 après la boucle
                j = 4
                Ecrit = Ecrit + 1
                'Si la cellule + 4 = XYX, on sort du programme
                'le curseur est placé en haut de la feuille
                ElseIf Cells(i + 4, Conte).Value = "XYX" Then
                    If ActiveSheet.Index < Sheets.Count Then
                        ActiveSheet.Next.Activate
                        i = 5
                        j = 5
                    Else
                     Cell(1, 1).Select
                     Exit Sub
                    End If
                End If
          Next
          Next
          Next
     End With
End Sub
Merci à ceux qui se pencheront sur mon cas.