Concatener par ligne si couleur de la cellule est rouge

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Delux
  • Date de début Date de début

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 !

S'inscrire
D

Delux

XLDnaute Occasionnel
Bonjour,

(excuser moi pour les accents mais je travaille avec un clavier americain)

Je me creuse la tete depuis quelques heures pour arriver a concatener, ligne par ligne, les cellules dont l'Interior.ColorIndex est rouge.

Il est important que la verification se face ligne par ligne.

J'ai commence le code mais je n'arrive pas a trouver la solution pour le terminer (il n'est pas dans le fichier exemple). il doit certainement etre faux :/

Code: 
Sub Concatenate_Color()

Dim i As Long
Dim Concat As String
Dim Cell As Range

i = 3 'demare de la troisieme ligne sur mon vrai fichier
Concat = concatenate

Do While Not IsEmpty(Cells(i, 1))

    For Each Cell In i
        If Cell.Interior.ColorIndex = 3 Then
        Concat =
        
End Sub


Quelqu'un aurait-il une solution a me proposer? (si possible avec les explications car j'aime bien comprendre et analyser le code)

En vous remerciant par avance

Codialement,

Delux 🙂
 

Pièces jointes

Trier par date Trier par votes
Re : Concatener par ligne si couleur de la cellule est rouge

Salut Modeste,

Merci pour ta reponse.
Est-ce normal que la formule concatenate apparaisse en colonne I?

Si cela est possible, j'aimerais que la formule s'execute dans la macro et que seul le resultat de la concatenation apparaisse.

Penses-tu que cela est possible?

Merci d'avance
 
Vote positif 0 Vote négatif
Re : Concatener par ligne si couleur de la cellule est rouge

Bonjour Delux, salut Modeste 🙂

Voyez le fichier joint et ce code dans Module1 :

Code: 
Public r As Range 'mémorise la variable

Sub Concatenate_Color()
Dim tablo, rc&, i&, t$, r1 As Range
If r Is Nothing Then Set r = Range("A2", [A65536].End(xlUp))
tablo = r.Offset(, 7) 'un tableau est plus rapide
rc = r.Count
For i = 1 To rc
  t = ""
  For Each r1 In r.Cells(i, 2).Resize(, 6)
    If r1 <> "" And r1.Interior.ColorIndex = 3 Then t = t & " - " & r1
  Next
  If rc = 1 Then tablo = Mid(t, 4): Exit For
  tablo(i, 1) = Mid(t, 4)
Next
r.Offset(, 7) = tablo
Set r = Nothing
End Sub
La macro se lance de 2 manières :

- soit par les touches Ctrl+A pour traiter toutes les lignes

- soit par double-clic sur une ligne pour la traiter.

Dans le code de Sheet1 :

Code: 
Private Sub Worksheet_BeforedoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row = 1 Then Exit Sub
Cancel = True
Set r = Cells(Target.Row, 1)
Concatenate_Color
End Sub
Edit : code revu pour rc = 1.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Concatener par ligne si couleur de la cellule est rouge

Merci Job75,

Je la testerai demain 😉

Par contre, pourrais tu me détailler le code avec des explications afin que je puisse être plus à l'aise avec celui-ci ?
(Je débute les macros)

Merci 🙂
 
Vote positif 0 Vote négatif
Re : Concatener par ligne si couleur de la cellule est rouge

Salut Job75,

C'est exactement ca 🙂

Par contre dans le module 1 tu mets cette ligne :

Code: 
 tablo = r.Offset(, 7) 'un tableau est plus rapide

Est-ce que cela signifie que tu te deplace 7 colonne a partir de A2?

Mon vrai tableau est situe en "F3😀A400". La concatenation doit apparaitre en "DC3😀C400"

Pourrais-tu me donner les explications pour que je puisse effectuer les modifications?

Desole d'abuser comme ca, mais je debute et j'aimerais apprendre 😱

Merci beaucoup 🙂
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Concatener par ligne si couleur de la cellule est rouge

Bonjour Delux, le forum,

Juste un petit complément avec le test If r.Row > 1 Then :

Code: 
Public r As Range 'mémorise la variable

Sub Concatenate_Color()
Dim tablo, rc&, i&, t$, r1 As Range
If r Is Nothing Then Set r = Range("A2", [A65536].End(xlUp))
If r.Row > 1 Then
  tablo = r.Offset(, 7) 'un tableau est plus rapide
  rc = r.Count
  For i = 1 To rc
    t = ""
    For Each r1 In r(i, 2).Resize(, 6)
      If r1 <> "" And r1.Interior.ColorIndex = 3 Then t = t & " - " & r1
    Next
    If rc = 1 Then tablo = Mid(t, 4): Exit For
    tablo(i, 1) = Mid(t, 4)
  Next
  r.Offset(, 7) = tablo
End If
Set r = Nothing
End Sub
Au cas où il n'y aurait rien sous la cellule A1.

Fichier (2).

Edit : r(i, 2) plus simple que r.Cells(i, 2)

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Concatener par ligne si couleur de la cellule est rouge

Job75,

J'ai modifie le fichier exemple pour y mettre mon vrai tableau (post #7).
Pourrais-tu y jeter un coup d'oeil et me dire ou dans ton code on doit proceder aux modifications?
Je suis debutant et ce code c'est un peu du chinois pour moi 🙁

Merci beaucoup pour ton aide

Cordialement,
 
Vote positif 0 Vote négatif
Re : Concatener par ligne si couleur de la cellule est rouge

Re,

Le fichier de votre post #7 est aussi du chinois pour moi :

- il n'y a plus de cellules colorées en rouge

- on ne voit pas dans quelles cellules il faut mettre le résultat de la concaténation.

Edit : ah si en colonne DC... Cela risque de faire de grands textes...

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Concatener par ligne si couleur de la cellule est rouge

Desole, les cellules en rouge etaient dues a une conditional formating :/
Je viens de le remettre

Si non j'ai essaye de comprendre par moi-meme mais il y a trop de donnees et je n'arraive pas a comprendre a quoi elles servent et quand est ce qu'elles interviennent dans le processus de calcul du code 🙁

Corrigez moi i je me trompe 😉

Code: 
Option Explicit
Public r As Range 'mémorise la variable

Sub Concatenate_Color()
Dim tablo, rc&, i&, t$, r1 As Range

If r Is Nothing Then Set r = Range("A2", [A65536].End(xlUp)) 'La je pense qu'on definit le tableau dans la ligne 2

If r.Row > 1 Then 'Si il y a plus d'une ligne

  tablo = r.Offset(, 7) 'la tu definit la derniere ligne du tableau contenant les donnees en partant de A2 (G2)
 
 rc = r.Count 'Je ne sais pas
  For i = 1 To rc 'Je ne sais pas
    t = "" 'Je ne sais pas
    
    For Each r1 In r.Cells(i, 2).Resize(, 6) 'la tu dis de partir de la ligne i (2) et deuxieme colonne donc B2 et de te rendre jusqu'en H2 certainement pour definir la cellule cible de la concatenation

      If r1 <> "" And r1.Interior.ColorIndex = 3 Then t = t & " - " & r1 'Si r1 (peut etre la cellule) n'est pas vide et qu'eele est rouge alors on donne l'ordre de concatener
    
    Next
    
    If rc = 1 Then tablo = Mid(t, 4): Exit For ' la je ne sais pas
 
   tablo(i, 1) = Mid(t, 4) ' la je ne sais pas
  
  Next
  
  r.Offset(, 7) = tablo 'et la je ne comprends pas 
End If

Set r = Nothing 'je ne sais pas

End Sub

Voila ce que j'ai compris du code, mais il me manque des donnees pour entierement le maitriser 🙁

Merci d'avance
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Concatener par ligne si couleur de la cellule est rouge

Re,

Bon j'ai mis quelques cellules rouges sur votre fichier.

Le double-clic sur une ligne ne ma paraît plus nécessaire.

J'ai fait une macro un peu différente :

Code: 
Sub Concatenate_Color()
Dim r As Range, tablo, i&, t$, r1 As Range
Set r = [F3:DA65536].Find("*", , xlValues, , xlByRows, xlPrevious) 'dernière cellule
If r Is Nothing Then Exit Sub
Set r = Range("F3:DA" & r.Row)
tablo = [DC3].Resize(r.Rows.Count) 'un tableau est plus rapide
For i = 1 To r.Rows.Count
  t = ""
  For Each r1 In r.Rows(i).Cells
    If r1 <> "" And r1.Interior.ColorIndex = 3 Then t = t & " - " & r1
  Next
  tablo(i, 1) = Mid(t, 4)
Next
[DC3:DC65536].ClearContents 'RAZ
[DC3].Resize(r.Rows.Count) = tablo
End Sub
Fichier joint.

Edit : par sécurité j'ai explicité xlByRows dans le Find.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Concatener par ligne si couleur de la cellule est rouge

Merci pour ce code, c'est parfait (meme si je ne le comprends pas en totalite :/ )

Cependant, il ne fonctionne pas sur mon fichier original.
Peut etre est-ce du au fait que j'ai plusieurs feuilles? La feuille de ce code est la Sheet3.

Desole de tout le derangement

Merci beaucoup
 
Vote positif 0 Vote négatif
Re : Concatener par ligne si couleur de la cellule est rouge

Re,

Vous parliez de Mise en forme conditionnelle (MFC).

Il est évident que .Interior.ColorIndex ne permet pas de connaître la couleur donnée par une MFC.

Dans le fichier joint j'ai appliqué une MFC (rouge) sur les colonnes F: DA avec cette formule :

Code: 
GAUCHE(F1;7)="PESDELT"
Il suffit de tester avec la même formule dans la macro :

Code: 
Option Compare Text 'pour ignorer la casse

Sub Concatenate_Color()
Dim r As Range, tablo, i&, t$, r1 As Range
Set r = [F3:DA65536].Find("*", , xlValues, , xlByRows, xlPrevious) 'dernière cellule
If r Is Nothing Then Exit Sub
Set r = Range("F3:DA" & r.Row)
tablo = [DC3].Resize(r.Rows.Count) 'un tableau est plus rapide
For i = 1 To r.Rows.Count
  t = ""
  For Each r1 In r.Rows(i).Cells
    If Left(r1, 7) = "PESDELT" Then t = t & " - " & r1 'formule de la MFC
  Next
  tablo(i, 1) = Mid(t, 4)
Next
[DC3:DC65536].ClearContents 'RAZ
[DC3].Resize(r.Rows.Count) = tablo
End Sub
A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Concatener par ligne si couleur de la cellule est rouge

Re,

Comme il n'y a plus besoin d'analyser chaque cellule, la macro est plus rapide avec 2 tableaux :

Code: 
Option Compare Text 'pour ignorer la casse

Sub Concatenate_Color()
Dim r As Range, tablo1, ncol%, tablo2, i&, t$, j%
Set r = [F3:DA65536].Find("*", , xlValues, , xlByRows, xlPrevious) 'dernière cellule
If r Is Nothing Then Exit Sub
tablo1 = Range("F3:DA" & r.Row) 'un tableau est plus rapide
ncol = UBound(tablo1, 2) 'nombre de colonnes
tablo2 = [DC3].Resize(UBound(tablo1))
For i = 1 To UBound(tablo1)
  t = ""
  For j = 1 To ncol
    If Left(tablo1(i, j), 7) = "PESDELT" Then t = t & " - " & tablo1(i, j) 'formule de la MFC
  Next
  tablo2(i, 1) = Mid(t, 4)
Next
[DC3:DC65536].ClearContents 'RAZ
[DC3].Resize(UBound(tablo1)) = tablo2
End Sub
Fichier (2).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

Discussions similaires

S
  • Résolu(e)
XL 2019 code vba changement de couleur si modification de la cellule
Réponses
7
Affichages
2 K
syriak
S
M
  • Question Question
XL 2016 Colorer une cellule sous une colonne suite à une saisie dans une autre cellule de la même ligne
Réponses
3
Affichages
793
mateo44
M
C
  • Résolu(e)
XL 2019 Supprimer des cellules en fonction d'une cellule de la ligne
2
Réponses
18
Affichages
2 K
chris4785478547
C
E
  • Question Question
Autres Changer la couleur des caractères compris entre 2 chaînes de caractères sur une ligne dans Excel 2007 avec une Macro
Réponses
6
Affichages
1 K
sylvanu
sylvanu
P
  • Résolu(e)
Microsoft 365 Copier et coller une ligne dans une autre cellule si la condition est respectée
Réponses
10
Affichages
2 K
Piksaw
P
G
  • Question Question
Griser des cellules vides si la cellule de la première ligne est un jour de semaine particulier
Réponses
2
Affichages
1 K
Gannet
G
R
  • Question Question
Valeur de la cellule dans macro
Réponses
2
Affichages
881
Ricco
R
A
  • Question Question
XL 2010 [résolu] [VBA] concatenation plage avec retour a la ligne et suppression de doublons
Réponses
3
Affichages
2 K
mapomme
mapomme
T
  • Question Question
XL 2013 Problème macro effacer le contenu d'une cellule en fonction de la couleur
Réponses
14
Affichages
3 K
thithithi
T
yves-melvine Kouadio
  • Question Question
Synthese par la somme de plusieurs classeurs
Réponses
2
Affichages
756
Paf
Paf
T
  • Question Question
VBA : Suppression de ligne selon la valeur d'une textbox
Réponses
4
Affichages
4 K
MarcLav
M
E
  • Question Question
Concatenation de deux colonnes et inserer cette concatenation dans une nouvelle colon
Réponses
2
Affichages
2 K
excel2010
E
P
  • Question Question
Un dernier et apres j'arrete: pb de definition de ligne
2 3
Réponses
32
Affichages
3 K
Payou
P
C
  • Question Question
Masquage de ligne par comparaison numérique
Réponses
14
Affichages
1 K
ccdouble6
C
P
  • Question Question
Pour chaque cellule de la ligne
Réponses
11
Affichages
2 K
ptitepo
P
N
  • Question Question
Compter les cellules de même couleur
Réponses
7
Affichages
3 K
Catrice
C
J
  • Question Question
Mise en forme d'une ligne par rapport à la valeur d'une cellule de cette ligne...
Réponses
5
Affichages
17 K
Jiheme
Jiheme
M
[REF] Wiki 4 de MichelXld (Fonctions, Evenements, Dates et calendriers, Flash , Ooo)
Réponses
0
Affichages
35 K
MichelXld
M
C
  • Question Question
PB : Changer la couleur de la ligne sélectionnée
Réponses
8
Affichages
1 K
AV
A
Retour