Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
982 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [VBA Excel] Interior.ColorIndex si...

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

[VBA Excel] Interior.ColorIndex si...

n°1534148
tibot
Posté le 27-03-2007 à 11:40:17  profilanswer
 

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 :)

mood
Publicité
Posté le 27-03-2007 à 11:40:17  profilanswer
 

n°1534191
olivthill
Posté le 27-03-2007 à 13:22:31  profilanswer
 

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

n°1534203
pyrof
Posté le 27-03-2007 à 13:37:49  profilanswer
 

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


 

n°1534251
tibot
Posté le 27-03-2007 à 14:32:01  profilanswer
 

Merci, j'ai testé :
 

Code :
  1. Dim L1 As Range
  2. Dim L2 As Range
  3. Sheets("liste1" ).Select
  4. Set L1 = Range("a1:a25" )
  5. Sheets("liste2" ).Select
  6. Set L2 = Range("a:a" )
  7. Dim lCell1 As Range
  8. Dim lCell2 As Range
  9. For Each lCell2 In L2
  10.     If lCell2.Text = "" Then Exit For
  11.     For Each lCell1 In L1
  12.         If lCell1.Text = lCell2.Text Then
  13.             lCell2.Interior.ColorIndex = 45
  14.         End If
  15.     Next
  16. 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 !!!!

n°1534266
pyrof
Posté le 27-03-2007 à 14:44:23  profilanswer
 


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


n°1534300
tibot
Posté le 27-03-2007 à 15:05:31  profilanswer
 

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  
 
 

n°1534349
pyrof
Posté le 27-03-2007 à 15:40:12  profilanswer
 

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

n°1534364
tibot
Posté le 27-03-2007 à 15:48:25  profilanswer
 

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
n°1534375
pyrof
Posté le 27-03-2007 à 15:57:07  profilanswer
 

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


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [VBA Excel] Interior.ColorIndex si...

 

Sujets relatifs
redimensionnement/affichage des colonnes Excel[AIDE] Formule Excel avec nom de feuille variable
Excel problème d'espace dans gestion de fondsMacro Excel
[VBA WORD] savoir si le document a déjà été enregistréCopier une feuille d'un fichier A vers un fichier B(excel)
VBA excel importer données access[VBA Excel] Eviter l'affichage de certains avertissements
Plus de sujets relatifs à : [VBA Excel] Interior.ColorIndex si...


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR