Discussion :

[nananinanana]

Bonjour à tous,

Ci dessous un code qui permet de situé dans un tableau le mot "figé" pour colorer la colonne,

Seulement il ne la conserve que la dernière position et donc ne colore que la dernière colonne concernée, avez vous une idée sur comment faire ?

Merci d'avance,

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
Sub color()
Dim cell As Range
Dim derc%
Dim derl%
Dim r As Integer
 
derc = Worksheets("GMD").Cells(2, Columns.Count).End(xlToLeft).Column
derl = Worksheets("GMD").Cells(Rows.Count, 2).End(xlUp).Row
At = Cells(7, derc).Address
doc_figé = Worksheets("gmd").Range("A1:At" & 5).Value
tableau = doc_figé
recherche = "Figé"
 
r = array_pos(tableau, recherche)
If r <> -1 Then
Cells(4, r).EntireColumn.Interior.ColorIndex = 15
End If
 
End Sub
 
Function array_pos(tableau, recherche)
 
array_pos = -1
 
    For i = LBound(tableau, 2) To UBound(tableau, 2)
        If tableau(4, i) = recherche Then 'Si valeur trouvée
        array_pos = i
        End If
    Next
 
End Function

[Philippe Tulliez]

Bonjour,
Tu as posé me semble-t-il une question sur le même sujet hier avec comme titre parcourir une ligne pour colorer une colonne

La mise en forme conditionnelle ne répondrait-elle pas à ton attente ?

[nananinanana]

Merci je suis passée par la mise en forme conditionnelle car cela prend trop de mémoire !
Bonne fin de journée

[parmi]

Bonjour,

Je pense que tu devrais arrêter la boucle avec un Exit...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
    For i = LBound(tableau, 2) To UBound(tableau, 2)
        If tableau(4, i) = recherche Then 'Si valeur trouvée
        array_pos = i
        Exit Function
        End If
    Next

[joe.levrai]

Bonjour,

en lisant ton premier code, on s'aperçoit que le problématique est réellement simplifiable.

- tu cherches le mot "Figé" uniquement sur la ligne 4, pourquoi donc aspirer l'intégralité de la plage plutôt que la seule ligne 4 ?
- tu travailles sur la colonne entière (=1 millions de lignes), pourquoi ne pas travailler sur les lignes utiles (via le usedrange) ?
- de même, tu travailles sur 46 colonne, pourquoi ne pas travailler sur les colonnes utiles (via le usedrange) ?


ainsi, la fonction n'est plus vraiment utile (mais demeure possible)
en tout cas, on n'a même plus besoin d'un array vu le faible gain de temps que ça va procurer (analyser 46 valeurs de cellules ...)

version en conservant ton array

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub colorARRAY()
Dim Tableau(), Recherche As String
    Tableau = Application.Transpose(Application.Transpose(ActiveSheet.UsedRange.Rows(4).Value)) ' uniquement la ligne 4
               Recherche = "Figé"
    ' pour chaque valeur de la ligne
    For i = LBound(Tableau) To UBound(Tableau)
        ' on ne colorie que la partie utilisée de la colonne si le mot Figé est sur la ligne 4
        If Tableau(i) = Recherche Then ActiveSheet.UsedRange.Columns(i).Interior.ColorIndex = 15
    Next i
End Sub

version sans le array

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub colorSansARRAY()
Dim Recherche As String, Cell As Range
    Recherche = "Figé"
 
    With ActiveSheet.UsedRange
        For Each Cell In .Rows(4).Cells
            If Cell.Value = Recherche Then .Columns(Cell.Column).Interior.ColorIndex = 15
        Next Cell
    End With
End Sub

attention, j'ai travaillé sur la feuille active ... car je mentionne au passage que tu joues sur deux tableaux dans ta procédure (une partie sur la feuille active et l'autre sur une feuille nommée)

[patricktoulon]

salut
y a largement plus simple

colore en rouge toute la colonne ou la cellule"figé" se trouve dans la ligne 4

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub test()
    Dim c
    Set c = ActiveSheet.Rows(4).Find("figé", lookat:=xlWhole)
    If Not c Is Nothing Then c.EntireColumn.Interior.ColorIndex = 3
End Sub

colore la colonne ou se trouve la cellule"figé" sur n'importe quelle ligne et uniquement sur la range utilisée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub test2()
    Dim c
    With ActiveSheet
        Set c = .UsedRange.Find("figé", lookat:=xlWhole)
        If Not c Is Nothing Then .Cells(.UsedRange.Row, c.Column).Resize(.UsedRange.Rows.Count, 1).Interior.ColorIndex = 3
    End With
End Sub

colore la colonne ou se trouve la cellule"figé" sur n'importe quelle ligne a partir de la ligne 1 jusqu’ à la dernière ligne utilisée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Sub test3()
    Dim c
    With ActiveSheet
        Set c = .UsedRange.Find("figé", lookat:=xlWhole)
        If Not c Is Nothing Then .Cells(1, c.Column).Resize(.UsedRange.Rows.Count + .UsedRange.Row - 1, 1).Interior.ColorIndex = 3
    End With
End Sub

une dernière :la même chose mais avec plusieurs occurrences

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub test4()    Dim c
    With ActiveSheet
        Set c = .UsedRange.Find("figé", lookat:=xlWhole)
        If Not c Is Nothing Then
        one = c.Address
        Do
           .Cells(1, c.Column).Resize(.UsedRange.Rows.Count + .UsedRange.Row - 1, 1).Interior.ColorIndex = 3
                Set c = .UsedRange.FindNext(c)
        Loop While Not c Is Nothing And c.Address <> one
    End If
    End With
End Sub

ca va aller ou je continu????