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

 

[Delux]

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

On s'en approche.

quand je fait CRTL+A sur mon tableau (il est trop lourd pour le mettre en piece jointe), cela selectionne tout le tableau :/

De plus, ma formule pour la MFC est:

=OR(VLOOKUP(F3, 'input edms'!$D$8:$M$7000, 9, 0)="S", VLOOKUP(F3, 'input edms'!$D$8:$M$7000, 9, 0)="")

Penses tu que je peux l'inserer a la place de la tienne?

If Left(tablo1(i, j), 7) = "PESDELT"

Desole de te faire perdre autant de temps.

Un grand MERCI en tout cas

 

[job75]

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

Re,

1) Je vois que vous ne savez pas affecter le raccourci clavier Ctrl+A à la macro :

- touches Alt+F8 et sélectionner la macro

- cliquer sur le bouton Options

- entrer la lettre a (minuscule) à droite de Ctrl+ => OK

- cliquer sur le bouton Annuler pour quitter la boîte de dialogue Macro.

2) La formule MFC ne peut pas être utilisée telle quelle dans la macro car la fonction VLOOKUP peut renvoyer une valeur d'erreur.

Il faut passer par la variable rech de type Variant :

Option Compare Text 'pour ignorer la casse

Sub Concatenate_Color()
Dim r As Range, PlageRech As Range, tablo1, ncol%, tablo2
Dim i&, t$, j%, rech As Variant
Set r = [F3:DA65536].Find("*", , xlValues, , xlByRows, xlPrevious) 'dernière cellule
If r Is Nothing Then Exit Sub
Set PlageRech = Sheets("input edms").[D8:M7000]
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
    rech = Application.VLookup(tablo1(i, j), PlageRech, 9, 0)
    If Not IsError(rech) Then
      If rech = "S" Or rech = "" Then t = t & " - " & tablo1(i, j)
    End If
  Next
  tablo2(i, 1) = Mid(t, 4)
Next
[DC3:DC65536].ClearContents 'RAZ
[DC3].Resize(UBound(tablo1)) = tablo2
End Sub

Nota : avec une recherche de ce genre pour chaque valeur la durée d'exécution peut être longue...

A+

 

[job75]

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

Bonjour Delux, le forum,

Deux compléments.

1) S'il y a beaucoup de cellules vides dans la plage F: DA et si la plage 'input edms'!D8: D7000 n'est pas remplie jusqu'en bas, cette macro sera beaucoup plus rapide :

Option Compare Text 'pour ignorer la casse

Sub Concatenate_Color()
Dim r As Range, PlageRech As Range, tablo1, ncol%, tablo2
Dim i&, t$, j%, rech As Variant
Set r = [F3:DA65536].Find("*", , xlValues, , xlByRows, xlPrevious) 'dernière cellule
If r Is Nothing Then Exit Sub
Set PlageRech = Intersect(Sheets("input edms").[D8:D7000], Sheets("input edms").UsedRange)
If PlageRech Is Nothing Then Exit Sub
Set PlageRech = PlageRech.Resize(, 9)
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 tablo1(i, j) <> "" Then
      rech = Application.VLookup(tablo1(i, j), PlageRech, 9, 0)
      If Not IsError(rech) Then
        If rech = "S" Or rech = "" Then t = t & " - " & tablo1(i, j)
      End If
    End If
  Next
  tablo2(i, 1) = Mid(t, 4)
Next
[DC3:DC65536].ClearContents 'RAZ
[DC3].Resize(UBound(tablo1)) = tablo2
End Sub

Nota : s'il y avait des valeurs d'erreur dans F: DA il faudrait en plus If Not IsError(tablo1(i, j)) Then

2) Pour être valide, la formule de la MFC que vous avez donnée ne doit pas utiliser des références d'une autre feuille donc :

- nommez Plage la plage 'input edms'!$D$8:$M$7000

- utilisez cette formule pour la MFC :

=IF(F3<>"",OR(VLOOKUP(F3,Plage,9,0)="S",VLOOKUP(F3,Plage,9,0)=""))

A+

 

[Delux]

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

Job75,

Merci pour ce code il fonctionne a merveille.
Je viens de le tester et tout fonctionne
Chapeau

Le temps de traitement est quasi instantane. Cela est peut-etre du au fait que pour le moment le tableau n'est pas complet. Il faudra un peu plus de recule pour avoir un feedback plus complet sur la duree de traitement.

Je pense que je vais eviter la MFC dans la macro (pour le moment) mais j'essayerai si finalement un probleme apparaissait.

Je vous remercie pour votre aide

Cordialement,

Delux