Discussion :

[antoninr]

Bonjour,

je commence tout juste a travailler sur les macro en vba sur excel
et je n'arrive pas a colorer des ligne en fonction des noms de la colonne A.

je m'explique:
en appuyant sur un bouton:si les noms de la collone A sont similaires j'aimerais les colorer des facon automatique.

information importante: le tableu est régénéré de tacon automatique grâce a une connexion odbc, il faut aussi savoir que grace au bouton date, je trie le tableau en fonction de l'année et du mois



voila merci d'avance

Antonin

[goldstar]

Bonjour,

Vous voulez que toutes les lignes portant le meme nom soient colorées de la meme couleur ?

[antoninr]

oui c'est bien cela
mais il faut que la coloration se fasse de facon automatique vu que le tableau est destiner a s'agrandir

[goldstar]

un truc du genre

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
 
 
 
Sub testii()
Dim table_1() As Variant, i As Long
Dim table_2() As Variant, j As Long, k As Long
Dim doublon As Boolean
Dim nbColol As Integer
Dim couleurLigne As Integer
 
'Derniere ligne de la colonne
derLigne = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
 
'nombre de Nom sans doublon
nbColol = 0
 
couleurLigne = 2 'Blanc
 
k = 1
 
'la plage de données
table_1 = Sheets("Feuil1").Range(Cells(1, 1), Cells(derLigne, 1)).Value
doublon = False
 
For i = 1 To UBound(table_1, 1)
    doublon = False
    For j = i + 1 To UBound(table_1, 1)
        If table_1(i, 1) = table_1(j, 1) Then
            doublon = True
        End If
    Next j
 
    If doublon = False Then
        nbColol = nbColol + 1
        ReDim Preserve table_2(1 To k)
        table_2(k) = table_1(i, 1)
        k = k + 1
    End If
Next i
 
'Boucle sur les éléments du tableau pour lire leur contenu
For i = 1 To nbColol
    leNom = table_2(i)
    couleurLigne = couleurLigne + 1
 
    For cpt = 1 To derLigne
        If Trim(Sheets("Feuil1").Cells(cpt, 1)) = leNom Then
            Sheets("Feuil1").Cells(cpt, 1).Interior.ColorIndex = couleurLigne
        End If
 
    Next cpt
 
Next i
End Sub

[antoninr]

merci beaucoup cela marche parfaitement