Plage de couleur

Le 07/05/2022 à 20:11

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"

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
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
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
Le 08/05/2022 à 04:03

Bonjour Jani2122

Merci de bien vouloir lire/relire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum et notamment :

  • Joignez (si possible) un fichier pour augmenter vos chances d'obtenir de l'aide en cliquant sur le bouton Fichier de l'éditeur. Si votre fichier est trop lourd ou contient des données personnelles, créez une version allégée de votre fichier avec juste assez d'informations pour permettre de comprendre votre problème. Dans tous les cas, ne postez JAMAIS de fichiers avec des informations personnelles ou confidentielles (cet utilitaire peut vous aider à les retirer).

Certes il y a "si possible" me direz-vous, mais dans votre cas c'est indispensable

Dans l'attente !

Rechercher des sujets similaires à "plage couleur"