Macro pour colorer des lignes en fonction de milliers de references

[PASCAL84810]

Bonjour,

J’utilise un fichier comprenant sur une feuille Excel des références d'emplacements de stockage dans la colonne A, une référence dans la colonne b, une quantité dans la colonne c. Dans le même emplacement je peux avoir plusieurs références : voir exemple en pièce jointe. ce fichier est mis a jour tout les jours et comprend 8000 lignes. Pour une meilleur lecture, je voudrais colorer un emplacement sur deux sur une, ou idéalement, les trois colonnes : comme dans la pièce jointe.
J'ai essayé de faire ce programme mais je n’arrive pas à paramétrer pour que cela fonctionne.
Je sais utiliser des macros faites par d’autre et modifier les paramètres de colonnes ou cellule pour les adapter à mon cas, mais Je n’ai pas l’habitude et ceci est mon premier essais de programmation.

Sub colorer()
Dim d As Integer,
Sheets("feuil1").Activate
For d = 5 To 40
Cells(d, 1).Select
If Cells(d, 1).Value = Cells(d - 1, 1).Value Then
Cells(d - 1, 1).Interior.ColorIndex = 4
ElseIf Cells (d, 1).Value <> Cells(i - 1, 1).Value Then
Cells(d+1, 1).Interior.ColorIndex = 4

Else
End If

Next
End Sub

merci pour votre aide

cordialement

 

[pierrejean]

Re : Macro pour colorer des lignes en fonction de milliers de references

Bonsoir Pascal
A tester:

Sub colore()
For n = 3 To Range("A" & Rows.Count).End(xlUp).Row
 If n Mod 2 <> 0 Then
  Range("A" & n & ":C" & n).Interior.ColorIndex = 4
 Else
  Range("A" & n & ":C" & n).Interior.ColorIndex = xlNone
 End If
Next
End Sub

 

[job75]

Re : Macro pour colorer des lignes en fonction de milliers de references

Bonsoir PASCAL84810, salut pierrejean

Sur un très grand tableau cette macro sera bien plus rapide (pas de boucle) :

Sub ColoreTableau()
'la colonne D est supposée ne pas contenir de données
Dim plage As Range
Application.ScreenUpdating = False
[A:C].Interior.ColorIndex = xlNone 'RAZ
Set plage = Range("A1:C" & Cells(Rows.Count, 1).End(xlUp).Row)
With plage.Columns(4) 'colonne D
  .Formula = "=1/MOD(ROW(),2)"
  Intersect(plage, .SpecialCells(xlCellTypeFormulas, 1).EntireRow).Interior.ColorIndex = 4
  .ClearContents 'RAZ
End With
plage.Rows(1).Interior.ColorIndex = xlNone
End Sub

Edit : testé avec 8402 lignes sur Win XP - Excel 2003 => exécution en 0,48 seconde.

A+

 

[PASCAL84810]

Re : Macro pour colorer des lignes en fonction de milliers de references

bonsoir,

je vous remercie tout les deux, vos macros fonctionnent, mais en fait j'aurai voulu
si colonne A contient :
a
a
a
b
c
c
d
que les cellules A1 A2 A3 soit en couleur, la cellule A4 blanc, les celulles A5 A6 en couleur, la cellule A7 en blanc, etc


cordialement

 

[Si...]

Re : Macro pour colorer des lignes en fonction de milliers de references

salut

voir Si... c'est cela :

Sub MFC()
  Dim Dl As Long, L As Long, C As Long
  Dim P As Range, R As Range
  Application.ScreenUpdating = False
  Dl = Cells(Rows.Count, 1).End(xlUp).Row
  C = 43
  Range("A3:C" & Dl).Interior.ColorIndex = xlNone
  Do Until Cells(3 + li, 1) = ""
    Set R = Cells(3 + li, 1)
    Do While R = R(1 + L, 1)
      L = L + 1
    Loop
    R.Resize(L, 3).Interior.ColorIndex = C
    C = IIf(C = 43, xlNone, 43)
    li = li + L
    L = 0
  Loop
End Sub

 

[job75]

Re : Macro pour colorer des lignes en fonction de milliers de references

Bonjour le fil, le forum,

Même principe qu'au post #3 mais avec 2 colonnes auxiliaires :

Sub Colorer()
'les colonnes D et E sont supposées ne pas contenir de données
Application.ScreenUpdating = False
[A:C].Interior.ColorIndex = xlNone 'RAZ
With Range("A1:C" & Cells(Rows.Count, 1).End(xlUp).Row)
  With .Columns(4).Offset(1) 'colonne D décalée
    .Cells(0) = 1
    .FormulaR1C1 = "=R[-1]C+(R[-1]C[-3]<>RC[-3])"
  End With
  .Columns(5).FormulaR1C1 = "=LN(MOD(RC[-1],2))"
  Intersect(.Cells, .Columns(5).SpecialCells _
  (xlCellTypeFormulas, 1).EntireRow).Interior.ColorIndex = 4
  .Rows(1).Interior.ColorIndex = xlNone
End With
[D:E].ClearContents 'RAZ
End Sub

Fichier joint.

Durée d'exécution sur 8402 lignes => 0,44 seconde.

A+

 

[PASCAL84810]

Re : Macro pour colorer des lignes en fonction de milliers de references

bonjour,

je vous remercie, SI... et job75, vos deux macros donnent le même resultat, et c'est exactement ce qu'il me fallait

trés cordialement

Pascal

 

[job75]

Re : Macro pour colorer des lignes en fonction de milliers de references

Re,

Pour être complet, voyez le fichier joint avec une solution par MFC sur A:C :

=SI(ET(LIGNE()>2;LIGNE()<=NB(tablo));MOD(INDEX(tablo;LIGNE());2))

Le nom défini tablo est créé par macro :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 1 Then Exit Sub
Dim tablo, tablo1, i&, n&
tablo = Range("A1", Cells(Rows.Count, 1).End(xlUp))
tablo1 = tablo
tablo1(1, 1) = 1: n = 1
For i = 2 To UBound(tablo)
  If tablo(i, 1) <> tablo(i - 1, 1) Then n = n + 1
  tablo1(i, 1) = n
Next
ThisWorkbook.Names.Add "tablo", tablo1 'nom défini
End Sub

A+

 

[PASCAL84810]

Re : Macro pour colorer des lignes en fonction de milliers de references

merci beaucoup,

quand j'aurai un peu de temps j'aissaierai de comprendre les macros

cordialement

 

[eramond]

Re : Macro pour colorer des lignes en fonction de milliers de references

Bonjour le fil, le forum,

Même principe qu'au post #3 mais avec 2 colonnes auxiliaires :

Sub Colorer()
'les colonnes D et E sont supposées ne pas contenir de données
Application.ScreenUpdating = False
[A:C].Interior.ColorIndex = xlNone 'RAZ
With Range("A1:C" & Cells(Rows.Count, 1).End(xlUp).Row)
  With .Columns(4).Offset(1) 'colonne D décalée
    .Cells(0) = 1
    .FormulaR1C1 = "=R[-1]C+(R[-1]C[-3]<>RC[-3])"
  End With
  .Columns(5).FormulaR1C1 = "=LN(MOD(RC[-1],2))"
  Intersect(.Cells, .Columns(5).SpecialCells _
  (xlCellTypeFormulas, 1).EntireRow).Interior.ColorIndex = 4
  .Rows(1).Interior.ColorIndex = xlNone
End With
[D:E].ClearContents 'RAZ
End Sub

Fichier joint.

Durée d'exécution sur 8402 lignes => 0,44 seconde.

A+

hello,

je me permets de deterrer ce cette discussion.

Comment puis améliorer cette macro en mettant la condition colorer les lignes qui contiennent la valeur indiqué en A1 par exemple?

merci

 

[eramond]

Re : Macro pour colorer des lignes en fonction de milliers de references

Merci à tous pour votre aide cela fonctionne