Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
Une solution de coloration de cellule à droite de la cellule active équivalent à la valeur de la cellule active.
Par un doubleclick dans l'une des cellules de la colonne A non vide, la macro évènementielle placée dans le module de la feuille colore le nombre souhaité de cellules.
Une solution de coloration de cellule à droite de la cellule active équivalent à la valeur de la cellule active.
Par un doubleclick dans l'une des cellules de la colonne A non vide, la macro évènementielle placée dans le module de la feuille colore le nombre souhaité de cellules.
Une petite modif afin de prendre en compte uniquement la cellule active :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ActiveCell.Column = 1 Then
Dim Valeur As Variant
Valeur = ActiveCell.Value
If Valeur > 0 Then
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, Valeur)).Interior.ColorIndex = 3
End If
End If
End Sub
Une petite modif afin de prendre en compte uniquement la cellule active :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ActiveCell.Column = 1 Then
Dim Valeur As Variant
Valeur = ActiveCell.Value
If Valeur > 0 Then
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, Valeur)).Interior.ColorIndex = 3
End If
End If
End Sub
Merci pour cette solution mais elle ne correspond pas tout a fait a ce que je souhaite( bien qu excellent travail et je te remercie )
car j importe les données dans la colonne A ( ou qu importe d ailleurs) et apres il faut que je cliques pour activer et balayer l ensemble des lignes .
Ce la va de la ligne A1 à A 6500 et je ne peux pas cliquer sur une a une .
Sub Colorier()
Dim derlig As Long
Dim lig As Long
With ActiveSheet
derlig = .Cells(.Rows.Count, 1).End(xlUp).Row
'remonter de la dernière ligne vers la première pour la colonne A
For lig = derlig To 1 Step -1
'si la cellule contient une valeur supérieure à 0 et que sa voisine
'de droite a une couleur différente de rouge
If .Cells(lig, 1) And .Cells(lig, 2).Interior.ColorIndex <> 3 Then
'colorier à partir de la colonne 2 jusqu'à la colonne x (valeur de la cellule)
.Cells(lig, 2).Resize(, .Cells(lig, 1).Value).Interior.ColorIndex = 3
End If
Next lig
End With
End Sub
Deuxième proposition:
Il faut que les cellules de la colonne A soient sélectionnées pour les lignes à colorier.
La couleur de fond est d'abord annulée (en cas de changement de nombre) puis éventuellement recoloriée.
Code:
Sub Colorier2()
Dim c As Range
With ActiveSheet
'si la sélection ne contient pas la colonne A->sortir
If Intersect(.Range("A:A"), Selection) Is Nothing Then Exit Sub
'Pour toutes les cellules de la colonne A dans la sélection
For Each c In Intersect(.Range("A:A"), Selection).Cells
'Effacer la couleur de fond des cellules allant de B à la dernière colonne
c.Offset(, 1).Resize(, .Columns.Count-1).Interior.ColorIndex = xlAutomatic
'Si c contient une valeur >0 et inférieur au nombre de colonne de la feuille
If c.Value > 0 And c.Value < .Columns.Count - 1 Then
'colorier les cellules allant de B au nombre de colonne contenu en A
c.Offset(, 1).Resize(, clng(c.Value)).Interior.ColorIndex = 3
End If
Next c
End With
End Sub
Sub Colorier()
Dim derlig As Long
Dim lig As Long
With ActiveSheet
derlig = .Cells(.Rows.Count, 1).End(xlUp).Row
'remonter de la dernière ligne vers la première pour la colonne A
For lig = derlig To 1 Step -1
'si la cellule contient une valeur supérieure à 0 et que sa voisine
'de droite a une couleur différente de rouge
If .Cells(lig, 1) And .Cells(lig, 2).Interior.ColorIndex <> 3 Then
'colorier à partir de la colonne 2 jusqu'à la colonne x (valeur de la cellule)
.Cells(lig, 2).Resize(, .Cells(lig, 1).Value).Interior.ColorIndex = 3
End If
Next lig
End With
End Sub
Deuxième proposition:
Il faut que les cellules de la colonne A soient sélectionnées pour les lignes à colorier.
La couleur de fond est d'abord annulée (en cas de changement de nombre) puis éventuellement recoloriée.
Code:
Sub Colorier2()
Dim c As Range
With ActiveSheet
'si la sélection ne contient pas la colonne A->sortir
If Intersect(.Range("A:A"), Selection) Is Nothing Then Exit Sub
'Pour toutes les cellules de la colonne A dans la sélection
For Each c In Intersect(.Range("A:A"), Selection).Cells
'Effacer la couleur de fond des cellules allant de B à la dernière colonne
c.Offset(, 1).Resize(, .Columns.Count-1).Interior.ColorIndex = xlAutomatic
'Si c contient une valeur >0 et inférieur au nombre de colonne de la feuille
If c.Value > 0 And c.Value < .Columns.Count - 1 Then
'colorier les cellules allant de B au nombre de colonne contenu en A
c.Offset(, 1).Resize(, clng(c.Value)).Interior.ColorIndex = 3
End If
Next c
End With
End Sub
Puisque notre Ami David à bien travaillé et que nous pouvons répondre,j'en profite pour te joindre un fichier avec une nouvelle version plus rapide sur 6500 lignes. Le classeur contient les deux versions.
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD
