Microsoft 365 colorer une plage

bd.afaf

XLDnaute Junior
Bonjour Forums;

je sais pas pourquoi on me colore toujours les cellules de la colonne janvier, je veux que le tint s'arrête dans la fin des données de janvier.

les colonnes en rose concernent les comptes de janvier Macro 1 ( de B2 jusqu'à B9 )

les colonnes en bleu concernent les comptes de février Macro 2 ' de A11 j'jusqu'à A17 , et D11 jusqu'à D17 )

du coup faut pas que j'aie les cellules au delà de B10 coloréé en Rose,

Voici la macro 1 de janvier e macro 2 de Février

elles contiennent un code d'un travail, où il y'a une partie de mise en forme (couleur) des colonnes .

PS: je veux ajouter le fichier ou l'image pour vous montrer le problème sur excel mais lors la copie dans la discussion on m'affiche " service indisponible"
VB:
Sub JANV()
'
' Macro3 Macro
'
'Synchronisation des anciens soldes et remonté des nouveaux soldes
    Range("B2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP([@Comptes],Tableau16[[N° de Compte]:[différence]],6,FALSE)),""Régulariser"",VLOOKUP([@Comptes],Tableau16[[N° de Compte]:[différence]],6,FALSE))"
        Range("Tableau1[janvier]").Select

   'copie coller de la formule
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'tri sur nouveau compte

 Dim nR As Long, kR As Long
      Sheets("Mois").Select
            ActiveSheet.ListObjects("Tableau16").Range.AutoFilter Field:=10, Criteria1:= _
        "Nouveau Compte"

     'Affectation des comptes et soldes vers les colonnes concernées
    nR = [Tableau16].Columns(1).SpecialCells(xlCellTypeVisible).Count '--- nb de lignes visibles du Tableau16 après filtrage
    kR = [Tableau1].Rows.Count                                       '--- nb de lignes dans Tableau1
    [Tableau16].Columns(3).Copy [Tableau1].Cells(kR + 0, 1)
    [Tableau16].Columns(8).Copy [Tableau1].Cells(kR + 0, 2)

    With Range([Tableau1].Cells(kR + 0, 2), [Tableau1].Cells(kR + nR, 2)).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0

    Worksheets("Tableau des écarts").Select
 Sheets("Mois").Select
    ActiveSheet.ListObjects("Tableau16").Range.AutoFilter Field:=10
    Sheets("Tableau des écarts").Select
 End With

End Sub
Code:




Capture.PNG

Code:
Sub FEV()
'
' Macro3 Macro  VERIFIER
'
'Synchronisation des nouveaux écarts des anciens comptes dans le mois présents
    Range("D3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP([@Comptes],Tableau16[[N° de Compte]:[différence]],6,FALSE)),""Régulariser"",VLOOKUP([@Comptes],Tableau16[[N° de Compte]:[différence]],6,FALSE))"
        Range("Tableau1[Février]").Select

  'Mise en forme
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""Régulariser"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False

  'copie coller fevrier

    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'tri sur nouveau compte

 Dim nR As Long, kR As Long
      Sheets("Mois").Select
            ActiveSheet.ListObjects("Tableau16").Range.AutoFilter Field:=10, Criteria1:= _
        "Nouveau Compte"

    'remonté des nouveaux comptes récement apparus dans le mois présent avec la même couleur que la cellule du mois
    nR = [Tableau16].Columns(1).SpecialCells(xlCellTypeVisible).Count '--- nb de lignes visibles du Tableau16 après filtrage
    kR = [Tableau1].Rows.Count                                       '--- nb de lignes dans Tableau1
    [Tableau16].Columns(3).Copy [Tableau1].Cells(kR + 1, 1)
    [Tableau16].Columns(8).Copy [Tableau1].Cells(kR + 1, 4)
    With Range([Tableau1].Cells(kR + 1, 1), [Tableau1].Cells(kR + nR, 1)).Interior
        .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0
        .PatternTintAndShade = 0

    With Range([Tableau1].Cells(kR + 1, 4), [Tableau1].Cells(kR + nR, 4)).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0
        .PatternTintAndShade = 0

    Worksheets("Tableau des écarts").Select
 Sheets("Mois").Select
    ActiveSheet.ListObjects("Tableau16").Range.AutoFilter Field:=10
    Sheets("Tableau des écarts").Select
 End With
 End With

 'distinguer les comptes récemment traité (ex: compte en janvier traité en février ) et ceux qui ont été traité plus d'un mois ( compte en décembre traité en janvier, doit apparaitre comme "déja traité" en février)

 Dim I As Integer
Dim Airejanvier As Range, AireFévrier As Range

    Set Airejanvier = Range("Tableau1[janvier]")
    Set AireFévrier = Range("Tableau1[Février]")
          'les comptes régulariser dans janvier === deja régulariser dans février
    For I = 1 To Airejanvier.Count
        If Airejanvier(I) = "Régulariser" And AireFévrier(I) = "Régulariser" Then
           AireFévrier(I) = "Déjà régulariser"
        End If

    Next I
' couleur déja traité
    With AireFévrier
         .FormatConditions.Add Type:=xlExpression, Formula1:="=D2=""Déjà régulariser"""
         .FormatConditions(.FormatConditions.Count).SetFirstPriority
         With .FormatConditions(1).Font
              .ThemeColor = xlThemeColorAccent6
              .TintAndShade = -0.249946592608417
         End With
         With .FormatConditions(1).Interior
              .PatternColorIndex = xlAutomatic
              .ThemeColor = xlThemeColorAccent6
              .TintAndShade = 0.599963377788629
         End With
        .FormatConditions(1).StopIfTrue = False
    End With

'''''les comptes deja régulariser dans janvier === deja régulariser dans février
  '
  '
  For I = 1 To AireFévrier.Count
        If Airejanvier(I) = "Déjà régulariser" And AireFévrier(I) = "Régulariser" Then
           AireFévrier(I) = "Déjà régulariser"
        End If
    Next I

' couleur déja traité

      With AireFévrier
         .FormatConditions.Add Type:=xlExpression, Formula1:="=D2=""Déjà régulariser"""
         .FormatConditions(.FormatConditions.Count).SetFirstPriority
         With .FormatConditions(1).Font
              .ThemeColor = xlThemeColorAccent6
              .TintAndShade = -0.249946592608417
         End With
         With .FormatConditions(1).Interior
              .PatternColorIndex = xlAutomatic
              .ThemeColor = xlThemeColorAccent6
              .TintAndShade = 0.599963377788629
         End With
        .FormatConditions(1).StopIfTrue = False
    End With
    Set Airejanvier = Nothing: Set AireFévrier = Nothing

End Sub
Code:
 

Robert

XLDnaute Barbatruc
Bonjour Bd.ataf, bonjour le forum,

Pas sûr d'avoir bien tout compris... Essaie ce petit bout de code :

VB:
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim PL As Range 'déclare la variable PL (PLAge)

Set O = Worksheets("Mois") 'définit l'onglet O
Set TS = O.ListObjects("Tableau1") 'définit le tableau structuré TS
COL = TS.HeaderRowRange.Find("janvier", , xlValues, xlWhole).Column 'récupère la colonne COL
Set R = TS.DataBodyRange.Columns(COL).Find("") 'définit la recherche R (Recherche du vide dans la colonne COL)
If R Is Nothing Then 'condition : 'si aucune occurrence n'est trouvée
    Set PL = TS.DataBodyRange.Columns(COL) 'définit la plage PL (les données de la colonne entière)
Else 'sinon
    LI = R.Row - TS.HeaderRowRange.Row - 1 'définit la ligne LI
    Set PL = Range(TS.DataBodyRange(1, COL), TS.DataBodyRange(LI, COL)) 'définit la plage PL
End If 'fin de la condition
With PL.Interior 'prend en compte la plage PL
    'coloration
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent2
    .TintAndShade = 0.599993896298105
    .PatternTintAndShade = 0
End With 'fin de la prise enc compte de la plage PL
End Sub
 

bd.afaf

XLDnaute Junior
Bonjour,

je craint que t'a mal compris le problème, je t'explique autrement/.

je colle les données de janvier avec une mise en forme ROSE dans les colonnes A et D

Lorsque je colle les données de février avec une mise en forme BLEU dans les colonnes A et F, la mise en forme de la colonne D qui est en rose est toujours activé .


Voici le problème dans l'image 1: lors le collage des données en février ( A et D ), même la mise en forme de la couleur de la colonne janvier ( B ) est activé .


prob.PNG




Voici le tableau que je souhaite avoir :
solution.PNG


Merci pour votre attention
 

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
299 956
Messages
1 980 368
Membres
207 067
dernier inscrit
Miks57450