Position dans un array

Version imprimable

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:

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

24/02/2017, 11h28
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 ?
27/02/2017, 12h12
nananinanana

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

Bonjour,

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

Code:

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

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:

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:

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)

salut
y a largement plus simple

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

Code:

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:

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:

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:

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????