Créer une plage à partir d'une plage

[Magic_Doctor]

Bonsoir,

J'ai, dans ma feuille, une plage nommée "BigPlage".
Dans cette plage il y a des cellules jaunes.
Je voudrais, à partir de la plage "BigPlage", créer la plage "PlageCelJaunes" qui ne contiendrait que les cellules jaunes de la plage précédente (plage "mère").

Comment s'y prendre ?

 

[Hieu]

Re : Créer une plage à partir d'une plage

Salut,

Je te propose une solution par macro (sans fichier exemple, dur de dire, si c'est c'que tu veux) :

Sub mlkj()
k = 0
For i = 0 To 8
If Range("a1").Offset(i, 0).Interior.Color = 65535 Then
    Range("d1").Offset(k, 0) = Range("a1").Offset(i, 0)
    k = k + 1
End If
Next i
End Sub

A adapter, suivant la couleur, et la taille de ta "big plage"

++

 

[Magic_Doctor]

Re : Créer une plage à partir d'une plage

Bonsoir Hieu,

Merci pour ta proposition, mais je voudrais récupérer les cellules concernées, non pas sur la feuille mais dans la macro même. Constituer un Range et n'avoir plus qu'à écrire Range.select pour sélectionner en bloc toutes les cellules concernées.

 

[eriiic]

Re : Créer une plage à partir d'une plage

Re,

Dim PlageCelJaunes As Range, c As Range
For Each c In [BigPlage]
    If c.Interior.Color = 65535 Then
        If PlageCelJaunes Is Nothing Then
            Set PlageCelJaunes = c
        Else
            Set PlageCelJaunes = Union(PlageCelJaunes, c)
        End If
    End If
Next c

eric

 

[Magic_Doctor]

Re : Créer une plage à partir d'une plage

Rebonsoir Eriiiic,

Bravo, ça marche !
Pour des raisons techniques, je dois supprimer de la sélection 2 cellules. J'ai essayé avec une cellule, ça marche, mais avec 2, il y en a toujours une qui reste. Supposons que ces cellules soient [L4] et [F6] (elles appartiennent à "BigPlage" et sont jaunes), comment s'y prendre ?

En tout cas, merci encore.

 

[job75]

Re : Créer une plage à partir d'une plage

Bonjour Magic_Doctor, Hieu, eriiiic,

Bravo, ça marche !

Bah tu as testé sur mon fichier de 30 000 lignes ???

https://www.excel-downloads.com/threads/recuperer-les-elements-dun-tableau.20007728/

Je me demande bien si ça vaut la peine de te donner cette solution qui coule de source :

Sub SelectionnerCouleurJaune()
Dim t, pas, tablo, c As Range, n, P As Range
t = Timer
pas = 100 'modifiable
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
  tablo = .Formula
  For Each c In .Cells
    If c.Interior.ColorIndex = 6 Then _
      Set P = Union(IIf(n, P, c), c): n = n + 1
    If n = pas Then n = 0: P = "#N/A"
  Next
  If n Then P = "#N/A"
  On Error Resume Next
  Set P = .SpecialCells(xlCellTypeConstants, 16)
  P.Select
  .Formula = tablo
End With
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

Fichier joint.

Edit : bien sûr si tu veux utiliser ta plage nommée tu écriras :

With [BigPlage] 'With ActiveSheet.UsedRange
'-----
  On Error Resume Next
  Set P = .SpecialCells(xlCellTypeConstants, 16)
  Application.Goto P

Bonne journée.

A+

 

[job75]

Re : Créer une plage à partir d'une plage

Re,

Et pour exclure des cellules de la sélection ce n'est pas bien sorcier :

Sub SelectionnerCouleurJaune()
Dim t, exclu As Range, pas, tablo, c As Range, n, P As Range
t = Timer
Set exclu = [B3,C4] 'à adapter
pas = 100 'modifiable
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
  tablo = .Formula
  For Each c In .Cells
    If Intersect(c, exclu) Is Nothing And c.Interior.ColorIndex = 6 _
      Then Set P = Union(IIf(n, P, c), c): n = n + 1
    If n = pas Then n = 0: P = "#N/A"
  Next
  If n Then P = "#N/A"
  On Error Resume Next
  Set P = .SpecialCells(xlCellTypeConstants, 16)
  P.Select
  .Formula = tablo
End With
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

Fichier (2).

Edit : avec ta plage nommée "BigPlage" :

Sub SelectionnerCouleurJaune()
'[BigPlage] doit être une plage rectangulaire
Dim t, exclu As Range, pas, tablo, c As Range, n, P As Range
t = Timer
pas = 100 'modifiable
Application.ScreenUpdating = False
With [BigPlage] 'ActiveSheet.UsedRange
  Set exclu = .Parent.[L4,F6] 'à adapter
  tablo = .Formula
  For Each c In .Cells
    If Intersect(c, exclu) Is Nothing And c.Interior.ColorIndex = 6 _
      Then Set P = Union(IIf(n, P, c), c): n = n + 1
    If n = pas Then n = 0: P = "#N/A"
  Next
  If n Then P = "#N/A"
  On Error Resume Next
  Set P = .SpecialCells(xlCellTypeConstants, 16)
  Application.Goto P
  .Formula = tablo
End With
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub

A+

 

[Magic_Doctor]

Re : Créer une plage à partir d'une plage

Bonsoir job, le forum,

On a une idée en tête, on ne peut la résoudre et on l'expose sur le forum.

J'ai une feuille de calculs sur des dilutions de produits pharmacologiques exprimés en unités (il y en a beaucoup).
Dans ma feuille j'ai tout au plus une trentaine de cellules où apparaissent des résultats. Autrement dit, ce n'est pas une base de données aux dimensions qui peuvent donner le vertige.
Si je rentre une erreur dans une cellule de saisie de données --> "? ? ?" dans certaines cellules de résultats.
Tous les résultats dans les cellules de résultats sont alignés à droite (ce sont des valeurs numériques).
Quand apparaissent des "? ? ?", je veux qu'ils soient centrés dans leur cellule (plus voyant et esthétique à mon sens).
Je rectifie l'erreur d'origine --> les "? ? ?" disparaissent et sont substitués par des résultats alignés à droite dans leur cellule.

Pour repérer tous les "? ? ?", j'avais au départ pensé à la solution de mapomme :

Sub ListeEnBleu()
'mapomme

Dim xcell As Range, tablo(), n&, plage

    For Each xcell In [bigplage]
        If xcell.Interior.Color = 13434879 Then
            n = n + 1
            ReDim Preserve tablo(1 To 1, 1 To n)
            tablo(1, n) = xcell.Address(0, 0)
        End If
    Next xcell
    
    Range("p:p").Clear
    Range("p45") = "En bleu"
    If n > 0 Then Range("p46").Resize(n) = Application.Transpose(tablo)
    
End Sub

Problème d'exploitation des données par la suite.

Eriiiic me propose la solution suivante :

Dim PlageCelJaunes As Range, c As Range
For Each c In [BigPlage]
    If c.Interior.Color = 65535 Then
        If PlageCelJaunes Is Nothing Then
            Set PlageCelJaunes = c
        Else
            Set PlageCelJaunes = Union(PlageCelJaunes, c)
        End If
    End If
Next c

Ça marche très bien, le seul problème est que je n'arrive pas à exclure certaines cellules jaunes dans la confection de "PlageCelJaune".

job75 et pierrejean me proposent leurs solutions. Je n'arrive pas à exploiter celles de pierrejean. Celles de job75 permettent, en un temps record, de traiter le problème sur une plage gigantesque. Le problème est que je ne parviens pas à adapter ses macros à mon projet.
Je reprends la solution d'Eriiiic en la modifiant :

Sub GestapoCel()
'Vérifie drastiquement, pour TOUS les calculs (qui se font TOUS dans des macros), s'il apparaît des "? ? ?" dans les cellules, et réalise une mise en forme en conséquence
'Eriiiic / Magic_Doctor

Dim PlageCelJaunes As Range, c As Range, x As Byte

    Sheets("BTX").Unprotect MotDePasse
    
    'vérifie s'il y a ou pas des "? ? ?" dans l'aire de travail
    For Each c In [bigplage]
        If c = "? ? ?" Then x = x + 1
    Next
    
    If x > 0 Then 'il y a un ou des "? ? ?"
        For Each c In [bigplage]
            If c = "? ? ?" Then 'cellules où il y a "? ? ?"
                If PlageCelJaunes Is Nothing Then
                    Set PlageCelJaunes = c
                Else
                    Set PlageCelJaunes = Union(PlageCelJaunes, c) 'toutes les cellules où il y a "? ? ?"
                End If
            End If
        Next c
        PlageCelJaunes.HorizontalAlignment = xlCenter 'tous les "? ? ?" sont centrés dans leur cellule respective
    Else 'il n'y a pas ou plus de "? ? ?"
        For Each c In [bigplage]
            If c.Interior.Color = 13434879 Then 'cellules jaunes
                If PlageCelJaunes Is Nothing Then
                    Set PlageCelJaunes = c
                Else
                    Set PlageCelJaunes = Union(PlageCelJaunes, c) 'toutes les cellules jaunes
                End If
            End If
        Next c
        PlageCelJaunes.HorizontalAlignment = xlRight 'le contenu de toutes les cellules jaunes, sans exception, est justifié à droite
        [F6].HorizontalAlignment = xlCenter 'cellule jaune dont le contenu est toujours centré
    End If
    
    Sheets("BTX").Protect MotDePasse, True, True, True
End Sub

Maintenant ça marche.
Mais je ne doute pas que l'on puisse encore simplifier cette macro.

 

[job75]

Re : Créer une plage à partir d'une plage

Bonjour Magic_Doctor, le forum,

Si les cellules avec "? ? ?" ou de couleur jaune ne sont pas trop nombreuses (une ou 2 centaines de zones disjointes) on peut utiliser Union sans précautions particulières.

Autant parcourir la plage une seule fois, c'est plus rapide :

Sub GestapoCel()
Dim P As Range, PJaune As Range, c As Range
With [BigPlage]
  .Parent.Protect MotDePasse, UserInterfaceOnly:=True
  For Each c In .Cells
    If c = "? ? ?" Then
      Set P = Union(IIf(P Is Nothing, c, P), c)
    ElseIf c.Interior.Color = 13434879 Then 'couleur jaune
      Set PJaune = Union(IIf(PJaune Is Nothing, c, PJaune), c)
    End If
  Next
  If Not P Is Nothing Then P.HorizontalAlignment = xlCenter
  If Not PJaune Is Nothing Then PJaune.HorizontalAlignment = xlRight
  .Parent.[F6].HorizontalAlignment = xlCenter 'cellule jaune toujours centrée
End With
End Sub

Bonne journée.

 

[Magic_Doctor]

Re : Créer une plage à partir d'une plage

Bonsoir job,

Je viens d'essayer ta macro. Super ! Et en une seule lecture des cellules.
¡Bravo!

Il y a un terme que je vois de plus en plus dans des macros, c'est "Parent".
Qu'est-ce que ça signifie au juste ?

En tout cas merci et une très bonne soirée.

PS : puisque tu es en Normandie, peux-tu demander à quelque Normand, si la confiture de lait (bien qu'elle est quasiment disparue en France) était autrefois faite à la maison par les grands-mères ? Il me semble que oui, du moins dans certaines régions françaises.
Ils prétendent ici (surtout les Argentins qui sont, pour le moins spéciaux à tous points de vue...) qu'ils l'ont inventé ("dulce de leche"). J'en doute. Comme pour le "faina" (une espèce de pizza sans rien, à base de farine de pois chiches), alors que c'est originaire du nord de l'Italie. À Nice (ancienne ville italienne) ça s'appelle "socca". Quoi qu'il en soit, le dulce de leche ici, même s'il est obsessionnel (il y en a de PARTOUT !!!), est le meilleur qui soit (je parle de l'industriel). Pour en avoir goûté ailleurs dont en France, fabriqué par des artisans.

 

[job75]

Re : Créer une plage à partir d'une plage

Bonsoir Magic_Doctor,

"Parent" est une propriété d'un objet.

Le "Parent" d'un objet Range c'est la Worksheet où il se trouve.

Le "Parent" d'un objet Sheet c'est le Workbook où il se trouve.

Quand à la confiture de lait on n'en trouve guère en Normandie, elle est surtout utilisée dans les confiseries (caramel).

https://fr.wikipedia.org/wiki/Confiture_de_lait

A+