Selection lignes contenant cellules colorées

[yahyaoui]

Bonjour,

S'il vous plait y'a t'il qcq peux m'aider d'avoir les Selection lignes contenant cellules colorées.

pour meilleur comprendre ci-joint un fichier.

merci d'avance

 

[JCGL]

Re : Selection lignes contenant cellules colorées

Bonjour à tous,
Bienvenue sur XLD,

Par fonction SOMMEPROD() :

=SOMMEPROD(($A$3:$A$5=H4)*($B$2:$C$2=J4)*$B$3:$C$5)

Si tu avais les mois en cellules non fusionnées, la formule serait étirable vers le bas.

A + à tous

 

[Robert]

Re : Selection lignes contenant cellules colorées

Bonjour Yahyaoui et bienvenu, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim pl1 As Range
Dim pl2 As Range
Dim cel As Range
Dim dest As Range

Set pl1 = Range("B3:C" & Cells(Application.Rows.Count, 1).End(xlUp).Row)
Set pl2 = Range("D3:E" & Cells(Application.Rows.Count, 1).End(xlUp).Row)
For Each cel In pl1
    If cel.Interior.ColorIndex <> xlNone Then
        Set dest = Cells(Application.Rows.Count, 8).End(xlUp).Offset(1, 0)
        dest.Value = Cells(cel.Row, 1).Value
        dest.Offset(0, 1).Value = Cells(1, cel.Column).MergeArea.Value
        dest.Offset(0, 1).NumberFormat = "dd/mm/yyyy"
        dest.Offset(0, 2).Value = Cells(2, cel.Column)
        cel.Copy dest.Offset(0, 3)
    End If
Next cel
For Each cel In pl2
    If cel.Interior.ColorIndex <> xlNone Then
        Set dest = Cells(Application.Rows.Count, 8).End(xlUp).Offset(1, 0)
        dest.Value = Cells(cel.Row, 1).Value
        dest.Offset(0, 1).Value = Cells(1, cel.Column).MergeArea.Value
        dest.Offset(0, 1).NumberFormat = "dd/mm/yyyy"
        dest.Offset(0, 2).Value = Cells(2, cel.Column)
        cel.Copy dest.Offset(0, 3)
    End If
Next cel
End Sub

 

[job75]

Re : Selection lignes contenant cellules colorées

Bonjour yahyaoui, salut JC, Robert 🙂

Autre solution VBA (Alt+F11) :

Sub Résultat()
Dim plage As Range, tablo, ub%, lig&, i&, j%
Application.ScreenUpdating = False
Set plage = [A1].CurrentRegion
tablo = plage 'matrice
ub = UBound(tablo, 2)
lig = 4 '1ère ligne des résultats
[H4:K65536].Delete xlUp 'RAZ
'---complète la 1ère ligne (dates)---
For j = 2 To ub Step 2
  tablo(1, j + 1) = tablo(1, j)
Next
'---copie les valeurs et les couleurs---
For i = 3 To UBound(tablo)
  For j = 2 To ub
    If plage(i, j).Interior.ColorIndex <> xlNone Then
      Cells(lig, "H") = tablo(i, 1)
      Cells(lig, "I") = tablo(1, j)
      Cells(lig, "J") = tablo(2, j)
      Cells(lig, "K") = tablo(i, j)
      Cells(lig, "K").Interior.Color = plage(i, j).Interior.Color
      lig = lig + 1
    End If
  Next
Next
End Sub

Fichier joint.

A+

 

[job75]

Re : Selection lignes contenant cellules colorées

Re,

En fait il y aura probablement plus de 2 articles chaque mois.

Il faut donc modifier la manière dont on complète la 1ère ligne (dates) :

'---complète la 1ère ligne (dates)---
For j = 3 To ub
  If tablo(1, j) = "" Then tablo(1, j) = tablo(1, j - 1)
Next

Fichier (2).

A+

 

[yahyaoui]

Re : Selection lignes contenant cellules colorées

Bonjour, c'est Génial!!!

Merci beaucoup JCGL, Robert , job75 et tous le forums.

Cordialement