[VBA Excel] Interior.ColorIndex si...

Marsh Posté le 27-03-2007 à 11:40:17

Bonjour,

Je souhaite coloriser le fond d'une cellule si celle ci contient une valeur.

J'ai 2 listes de références numériques.
La liste 2 contient l'ensemble des références, la liste 1 un extrait de la liste 2 ( 25 ref)
Je veux que dans la liste 2 les ref présentent dans la liste 1 soient avec un fond colorisé.
Les listes sont dans un même classeur mais dans 2 feuilles différentes.

J'utilise un macro boucle mais je débogage 1004 (ligne bleue)

Dim L1 As Range
Dim L2 As Range
Sheets("liste1" ).Select
Set L1 = Range("a1:a25" )
Sheets("liste2" ).Select
Set L2 = Range("a:a" )
j = 3
While Cells(j, 2) <> ""
If L2.Cells(i).Value = L1 Then
L2.Cells(i).Interior.ColorIndex = 45
End If
j = j + 1
Wend

Une idée ?
Merci

Reply

Marsh Posté le 27-03-2007 à 11:40:17

Reply

Marsh Posté le 27-03-2007 à 13:22:31

Utiliser Find, par exemple :

Sub colorise_liste2()
' Met en orange les cellules L2!B3-Bn
' pour lesquelles les cellules L2!A3-An existent dans L1
Dim L1 As Range
Dim L2 As Range
Sheets("liste1" ).Select
Set L1 = Range("a1:a5" )
Sheets("liste2" ).Select
Set L2 = Range("a:a" )
j = 3
While Cells(j, 2) <> ""
If (L1.Find(what:=Cells(j, 1), LookIn:=xlValues) Is Nothing) Then
Cells(j, 2).Interior.ColorIndex = 0
Else
Cells(j, 2).Interior.ColorIndex = 45
End If
j = j + 1
Wend

End Sub

Reply

Marsh Posté le 27-03-2007 à 13:37:49

Bonjour,

Voici une proposition :

Sub pyrof_01()
Dim tab_cle
Set tab_cle = CreateObject("Scripting.Dictionary" )
For Each cellule In Range("liste2" )
tab_cle.Add "c" & cellule.Value, "1"
Next
'-----------------------------------------------
For Each cellule In Range("liste1" )
If tab_cle("c" & cellule) = 1 Then cellule.Interior.ColorIndex = 45
Next
End Sub

Reply

Marsh Posté le 27-03-2007 à 14:32:01

Merci, j'ai testé :

Code :

Dim L1 As Range
Dim L2 As Range
Sheets("liste1" ).Select
Set L1 = Range("a1:a25" )
Sheets("liste2" ).Select
Set L2 = Range("a:a" )
Dim lCell1 As Range
Dim lCell2 As Range
For Each lCell2 In L2
If lCell2.Text = "" Then Exit For
For Each lCell1 In L1
If lCell1.Text = lCell2.Text Then
lCell2.Interior.ColorIndex = 45
End If
Next
Next

Ça fonctionne si je n'ai pas d'entête de colonne

Il faut donc que je modifie le range de L2 et c'est bon !!
un truc du genre Range("a3", Selection.End(xlDown)).Select
mais ici la syntaxe n'est pas bonne ...

Merci !!!!

Reply

Marsh Posté le 27-03-2007 à 14:44:23

encore plus simple et rapide

Sub pyrof_01a()
Dim tab_cle
Set tab_cle = CreateObject("Scripting.Dictionary" )
For Each cellule In Range("liste2" )
tab_cle("c" & cellule.Value) = "45"
Next
'-----------------------------------------------
For Each cellule In Range("liste1" )
cellule.Interior.ColorIndex = tab_cle("c" & cellule)
Next
End Sub

Reply

Marsh Posté le 27-03-2007 à 15:05:31

oui meric ça focntionne mieux mais ça dure plus longtemps.

(tu as juste interverti liste un et liste 2 )

par contre pour diminuer le temps de traitement il faut que je délimite le range de ma liste 2 qui fait environ 3000l lignes (nombre de ligne variable)

c'est pourquoi je souhaite mettre le range à partir de la ligne 3 jusqu'à la dernier cellule pleine.
C'est du genre :

Range("a3", Selection.End(xlDown)).Select

Reply

Marsh Posté le 27-03-2007 à 15:40:12

C'est encore moi,

je me permets de te demander pour ton dernier message, tu as utilisé quelle solution

La solution

for
___ for
________if then
___ next
next

prend beaucoup de temps car pour chaque ligne, il faut lire les lignes de l'autre liste pour trouver l'égalité.

pour réduire un peu fait

for
___ for
________if then
___________exit for
________end if
___ next
next

il sortira de la boucle si il a trouvé l'égalité

la solution que je donne précédemment parcours une seule fois chaque liste elle devrait donc être plus rapide

salutation

Reply

Marsh Posté le 27-03-2007 à 15:48:25

oui oui j'utilise la tienne et je t'assure qu'elle prenait 10 secondes de plus.
j'ai réduis le temps en délimitant le range de la liste2, jusqu'a 10000 lignes et non les 65000 car je n''arrive pas spécifier le range jusqu'à la dernier cellule pleine de type Range("a3", Selection.End(xlDown)).Select

encore merci !

Message édité par tibot le 27-03-2007 à 15:51:29

Reply

Marsh Posté le 27-03-2007 à 15:57:07

OK

Je pensais que cela aurait été plus rapide de fait de travailler en mémoire plutot que de faire faire accès aux cellules.

Mais il est vrai que tu analyses beaucoup de lignes cela charge peut être trop la mémoire.

Bonne soirée

Reply

[VBA Excel] Interior.ColorIndex si...

Sujets relatifs:

Leave a Replay