MFC sur plage nommée de lignes

Bonjour,

version 3 : ajout suppression de lignes "à la demande" en sélection simple ou multiple et la MFC ne fonctionne que sur les lignes dont les deux colonnes sont remplies :

J'ai remis la suppression et ajout de la MFC pour éviter la petite manip journalière, hebdomadaire ou mensuelle

@ bientôt

LouReeD

Une image vaut mieux qu'un long discours, voici un fichier joint bien plus explicit.

J'ai conservé ma solution où je dégomme et recrée des MFC sur mesure ligne à ligne (mon message d'hier soir).

En effet : si je conserve la possibilité d'effacer le formatage via un booléen targetcolor ou bien que l'on clique en dehors du databodyrange, c'est à mon sens la solution la moins pénible en longueur et maintenance du code. Mais uniquement pck je n'ai pas d'autres MFC sur le TS.

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lsto As ListObject

    Set lsto = ThisWorkbook.Sheets(1).ListObjects(1)
    With lsto
        If .DataBodyRange Is Nothing Then GoTo FIN

        .Range.FormatConditions.Delete

        If Not Intersect(Target, .DataBodyRange) Is Nothing _
        And Target.CountLarge = 1 _
        And [Prm_targetcolor] = "True" _
            Then Call TargetColor(Target)
    End With

FIN:
End Sub
Sub TargetColor(Target As Range)
Dim Target_i&, diese As String, prev As String
Dim clés, clé, cell As Range, Départ As String
Dim dico As Object
Dim lsto As ListObject

    Set lsto = ThisWorkbook.Sheets(1).ListObjects(1)
    With lsto
        Target_i = Target.Row - .HeaderRowRange.Row
        diese = .DataBodyRange(Target_i, .ListColumns("#").Index).Value
        prev = .DataBodyRange(Target_i, .ListColumns("previous").Index).Value
        clés = Split(prev & ";" & diese, ";")
        Set dico = CreateObject("Scripting.Dictionary")

        If Not Intersect(Target, .DataBodyRange) Is Nothing Then

    '*** Recherche lignes où diese&previous présents
            For Each clé In clés
                If Not clé = "NEW" _
                And Not clé = "!" _
                And Not clé = "" Then
                    With Union(.ListColumns("previous").DataBodyRange, _
                               .ListColumns("#").DataBodyRange)
                        Set cell = .Find(clé, LookIn:=xlValues)
                        If Not cell Is Nothing Then
                            Départ = cell.Address
                            Do
                                If Not dico.exists(cell.Row) Then dico.Add cell.Row, Nothing
                                Set cell = .FindNext(cell)
                            Loop Until cell.Address = Départ
                        End If
                    End With
                End If
            Next
        End If

    '*** Mise en surbrillance
        If dico.Count > 0 Then
            With .DataBodyRange.FormatConditions
                For Each clé In dico.keys
                    With .Add(xlExpression, , "=LIGNE()=" & clé & "")
                        .Interior.Pattern = xlGray25
                        .Interior.PatternThemeColor = xlThemeColorAccent1
                    End With
                Next clé
                With .Add(xlExpression, , "=COLONNE()=" & Target.Column & "")
                    .Interior.Pattern = xlGray25
                    .Interior.PatternThemeColor = xlThemeColorAccent1
                End With
            End With
        End If
    End With

Set dico = Nothing
End Sub
6test.xlsm (23.15 Ko)

Il semble que mon message ne soit pas parti ...

Voici un fichier plus explicite afin d'illustrer mes propos.

Je trouve la solution de dégommer la MFC à chaque selectionchange plus intéressante en terme de longueur et maintenance de code, uniquement car il n'y a pas d'autres MFC dans le TS (cela réponds aussi à la remarque de Bart sur l'insertion de lignes). D'autant plus que j'ai les contraintes d'un booléen pour afficher ou non un formatage, ainsi que la volonté de ne pas formater si clique en dehors du databodyrange.

7test.xlsm (22.71 Ko)

re,

@LouReeD, une macro pour supprimer les doublons (dans 99% des cas)

Option 1 = si on n'a pas personnalisé le TS (ajout des couleurs ou modif du font ou ... dans des cellules individuelles)

Option 2 = avec des formules et des plages "normalles"

Sub LouReed()
     Dim N

     With Range("tableau1").ListObject.DataBodyRange     'le body du TS
          N = .Rows.Count                    'nombre de lignes
          If N > 1 Then
               .Offset(1).Resize(N - 1).FormatConditions.Delete     'supprimer les MFCs à partir de la 2eme ligne

               If False Then                 'oubien méthode 1
                    .Rows(1).Copy
                    .PasteSpecial xlPasteFormats
               Else                          'oubien méthode 2
                    With .Rows(1)
                         For i = 1 To .FormatConditions.Count' boucler les MFCs
                              With .FormatConditions(i)'une MFC
                                   For Each ar In .AppliesTo.Areas 'traiter chaque plage contigue
                                        .ModifyAppliesToRange ar.Resize(N)
                                   Next
                              End With
                         Next
                    End With
               End If
          End If
     End With
End Sub

alors, je le ferais comme ceci, le tableau s'occupe des MFCs et la macro "LouReed" s'occupe des doublons.

Pour moi, il suffit même de lancer cette macro en ouvrant le fichier avec "Workbook_Open" in thisworkbook

Mais à mon avis, c'est encore trop compliqué, c'est quoi le but ?

Le but est visuel. Repérage dans un grand volume de données, des précédents et succédants à partir d'une ligne cliquée.

comme ceci est déjà plus simple, mais on n'est pas encore au bout du simplicité ...

La macro et la MFC sont modifiées

Rechercher des sujets similaires à "mfc plage nommee lignes"