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
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.
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 Subalors, 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