Déplacement dans les cellules

**rch05** · 31/01/2011, 10h56

Bonjour,

J'aimerai simplifier le code ci-dessous

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
 
i = 56
t = 40
Range("N40").Select
For a = 1 To 10
    i = i + 1
    t = t + 1
 
    If Range("B" & i).Font.Color = RGB(255, 0, 0) Then
        Range("N" & t).Interior.ColorIndex = 37
    End If
    If Range("C" & i).Font.Color = RGB(255, 0, 0) Then
        Range("O" & t).Interior.ColorIndex = 37
    End If
    If Range("D" & i).Font.Color = RGB(255, 0, 0) Then
        Range("P" & t).Interior.ColorIndex = 37
    End If
    If Range("E" & i).Font.Color = RGB(255, 0, 0) Then
        Range("Q" & t).Interior.ColorIndex = 37
    End If
    If Range("F" & i).Font.Color = RGB(255, 0, 0) Then
        Range("R" & t).Interior.ColorIndex = 37
    End If
    If Range("G" & i).Font.Color = RGB(255, 0, 0) Then
        Range("S" & t).Interior.ColorIndex = 37
    End If
    If Range("H" & i).Font.Color = RGB(255, 0, 0) Then
        Range("T" & t).Interior.ColorIndex = 37
    End If
    If Range("I" & i).Font.Color = RGB(255, 0, 0) Then
        Range("U" & t).Interior.ColorIndex = 37
    End If
    If Range("J" & i).Font.Color = RGB(255, 0, 0) Then
        Range("V" & t).Interior.ColorIndex = 37
    End If
    If Range("K" & i).Font.Color = RGB(255, 0, 0) Then
        Range("W" & t).Interior.ColorIndex = 37
    End If
 
    If Range("L" & i).Font.Color = RGB(255, 0, 0) Then
        Range("X" & t).Interior.ColorIndex = 37
    End If
    If Range("M" & i).Font.Color = RGB(255, 0, 0) Then
        Range("Y" & t).Interior.ColorIndex = 37
    End If
    If Range("N" & i).Font.Color = RGB(255, 0, 0) Then
        Range("Z" & t).Interior.ColorIndex = 37
    End If
    If Range("O" & i).Font.Color = RGB(255, 0, 0) Then
        Range("AA" & t).Interior.ColorIndex = 37
    End If
    If Range("P" & i).Font.Color = RGB(255, 0, 0) Then
        Range("AB" & t).Interior.ColorIndex = 37
    End If
    If Range("Q" & i).Font.Color = RGB(255, 0, 0) Then
        Range("AC" & t).Interior.ColorIndex = 37
    End If
    If Range("R" & i).Font.Color = RGB(255, 0, 0) Then
        Range("AD" & t).Interior.ColorIndex = 37
    End If
    If Range("S" & i).Font.Color = RGB(255, 0, 0) Then
        Range("AE" & t).Interior.ColorIndex = 37
    End If
    If Range("T" & i).Font.Color = RGB(255, 0, 0) Then
        Range("AF" & t).Interior.ColorIndex = 37
    End If
 
Next

J'ai essayé d'effectuer avec une deuxième boucle en me déplacent d'une colonne, et cela ne fonctionne pas.

Pourriez-vous m'aider à améliorrer cette codification.

Par avance merci de votre aide.

**casefayere** · 31/01/2011, 11h39

Bonjour,
essaies ce code et améliores le à tes besoins

Code :

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

1
2
3
4
5
6
7
8
Dim I As Long, T As Long
For T = 41 To 50
    For I = 2 To 21
        If Cells(T + 16, I).Font.Color = 255 Then
            Cells(T, I + 12).Interior.ColorIndex = 37
        End If
    Next I
Next T

**mercatog** · 31/01/2011, 13h08

En une seule boucle (pour moins de lignes mais traitement identique)

Code :

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

1
2
3
4
5
Dim c As Range
Application.ScreenUpdating = False
For Each c In Sheets("Feuil1").Range("B57:T66") 'adapter le nom de la feuille
    c.Offset(-16, 12).Interior.ColorIndex = 37 * Abs(c.Font.Color = 255)
Next c

**casefayere** · 31/01/2011, 15h53

Bonjour mercatog, re le forum, rch05

Je suis obligé de passer ce post pour te dire, mercatog, que tu m'étonneras toujours, aie aie!, j'ai encore du chemin à faire

Bonne journée

PS : par contre, si tu mets

Code :

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

Application.ScreenUpdating = False

je crois qu'il faut spécifier aux non habitués qu'à la fin du code

Code :

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

Application.ScreenUpdating = true

j'ai déjà eu des surprises avec cet oubli

**MarcelG** · 31/01/2011, 16h11

Bonjour et ravi de te retrouver mercatog,
Bonjour casefayere,

Le code est actif bien entendu.

Au demeurant, j'ai voulu essayer d'appliquer la méthode sur le bloc complet, plutôt que sur les cellules qui le composent.

[

Code :

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

1
2
3
4
5
6
CODE]Public Sub essai()
Application.ScreenUpdating = False
With Sheets("Feuil1").Range("B57:T66")
    .Offset(-16, 12).Interior.ColorIndex = 37 * Abs(.Font.Color = 255)
End With
End Sub

[/CODE]

Sans résultat. Sinon tu y aurais pensé mercatog, j'en suis sûr.
Mais pourquoi.

**rch05** · 31/01/2011, 16h11

Bonjour à tous les 2,

Vous êtes très fort.
J'ai appliqué le code de casefayere et puis celui de mercatog, et cela fonctionne très bien.
Si j'ai bien compris (étant un jeune débutant), il faudrait que mette Application.ScreenUpdating à true à la fin du code.
En regadant l'aide (F1) il le précise.

Chapeau bas messieurs

J'en apprends avec vous sur ce site

Encore une fois merci de vos explications et de votre aide TRES PRECIEUSE

Christian

**rch05** · 31/01/2011, 17h29

Re bonjour messieurs,

Je me suis trop emballé.
En effectuant le test, j'ai remarqué qu'il m'écrasé les cellules non concernées.

Je m'explique:
Si la celulle A1 à le texte en rouge, je mets la cellule AA1 une couleur de font.
Mais là, il écrase la cellule à blanc si le le texte n'est pas en rouge.
Avez-vous une solution?

Christian

**mercatog** · 31/01/2011, 18h40

Un If suffirait

Code :

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

1
2
3
4
5
Dim c As Range
Application.ScreenUpdating = False
For Each c In Sheets("Feuil1").Range("B57:T66") 'adapter le nom de la feuille
    If c.Font.Color = 255 then c.Offset(-16, 12).Interior.ColorIndex = 37
Next c

**rch05** · 31/01/2011, 18h52

Merci mercatog,

J'aurai du y penser, mais c'est la fonction Abs qui me gênait.

Un grand merci de ton aide

Cordialement
Christian

**mercatog** · 31/01/2011, 19h12

Code :

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

1
2
3
For Each c In Sheets("Feuil1").Range("B57:T66") 'adapter le nom de la feuille
    c.Offset(-16, 12).Interior.ColorIndex = 37 * Abs(c.Font.Color = 255)
Next c

est l'équivalent de

Code :

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

1
2
3
For Each c In Sheets("Feuil1").Range("B57:T66") 'adapter le nom de la feuille
    c.Offset(-16, 12).Interior.ColorIndex = - 37 * (c.Font.Color = 255)
Next c

En effet, la proposition logique (c.Font.Color = 255) = -1 si c'est vrai et 0 si c'est faux
qui est l'équivalent classique de

Code :

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

1
2
3
4
5
6
7
For Each c In Sheets("Feuil1").Range("B57:T66")   'adapter le nom de la feuille
   If c.Font.Color = 255 Then
      c.Offset(-16, 12).Interior.ColorIndex = 37
   Else
      c.Offset(-16, 12).Interior.ColorIndex = 0
   End If
Next c

Pour ne pas toucher à tes couleurs initiales, il suffit de supprimer ce que fait Else

**rch05** · 31/01/2011, 22h20

Bonsoir mercatog,

Un grand merci de tes explications.
J'ai pris l'option du IF sans Else, car la couleur initiale ne doit pas être touchée.
Mais la fonction ABS, me servira surement.
Maintenant cela fonctionne très bien.

Bonne soirée,
Et surement à bientôt.....

Cordialement
Christian

Déplacement dans les cellules [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager