Concatener par ligne si couleur de la cellule est rouge

[Delux]

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

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

 

[Modeste]

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

Bonjour Delux,

Avec une fonction personnalisée (voir colonne I pour le résultat), définie dans un module standard, peut-être ... si j'ai bien compris!?

 

[Delux]

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

 

[job75]

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

Bonjour Delux, salut Modeste

Voyez le fichier joint et ce code dans Module1 :

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 :

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+

 

[Delux]

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

 

[job75]

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

Re,

Attention, macro du post #4 modifiée : If rc = 1 Then tablo = Mid(t, 4): Exit For

A+

 

[Delux]

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 :

 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 "F3A400". La concatenation doit apparaitre en "DC3C400"

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

 

[job75]

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 :

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+

 

[Delux]

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,

 

[job75]

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+

 

[Delux]

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

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

 

[job75]

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 :

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+

 

[Delux]

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

 

[job75]

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 :

GAUCHE(F1;7)="PESDELT"

Il suffit de tester avec la même formule dans la macro :

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+

 

[job75]

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 :

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+