XL 2013 Comparer plage de cellules Feuil1 avec plage de cellules Feuil2

[hyperion13]

Salut à toute la communauté

J'essaie à l'aide de VBA de comparer 1 plage de cellules d'une feuille de calculs avec une autre plage de cellules dans une autre feuille de calculs.
- la Feuil1 contient de A2:A14 la liste des jours fériés en France
- la Feuil2 contient de A2:A23 la liste des jours ouvrés du mois de novembre
Si des dates sont identiques (01/11/2021 et 11/11/2021) pourvoir appliquer une couleur de remplissage aux cellules de la Feuil2.
J'ai fait une macro, mais rien ne se passe
Si quelqu'un pouvait m'aider, merci d'avance.

Sub ComparerDates()
Dim xlwbk As Workbook, xlwbs As Worksheet, xlwbs1 As Worksheet
Dim DernLigneJf As Long, DernLigneMois As Long
Dim i As Long, j As Long

Set xlwbk = ThisWorkbook
Set xlwbs = Worksheets("Feuil1") 'liste dates jours fériés de A2:A14
Set xlwbs1 = Worksheets("Feuil2") 'liste jours ouvrés d'un mois de A2:A23

DernLigneJf = xlwbs.Cells(xlwbs.Rows.Count, "A").End(xlUp).Row
DernLigneMois = xlwbs1.Cells(xlwbs1.Rows.Count, "A").End(xlUp).Row

For i = 2 To DernLigneJf
    For j = 2 To DernLigneMois
        If xlwbs.Cells(i, 1) = xlwbs1.Cells(j, 1) Then
            xlwbs1.Cells(j, 1).Interior.ColorIndex = 18
        Else
            xlwbs1.Cells(j, 1).Interior.ColorIndex = xlColorIndexNone
        End If
    Next j
Next i
End Sub

 

[Robert]

Bonjour Hyperion, bonjour le forum,

Peut-être comme ça :

Sub ComparerDates2()
O1 As Worksheet, O2 As Worksheet
Dim PL1 As Range, PL2 As Range
Dim CEL1 As Range, CEL2 As Range

Set O1 = Worksheets("Feuil1")
Set O2 = Worksheets("Feuil2")
Set PL1 = O1.Range("A2:A14")
Set PL2 = O2.Range("A2:A23")
For Each CEL1 In PL1
    For Each CEL2 In PL2
        If CEL1.Value = CEL2.Value Then
            CEL2.Interior.ColorIndex = 18: Exit For
        Else
            CEL2.Interior.ColorIndex = xlNone
        End If
    Next CEL2
Next CEL1
End Sub

 

[hyperion13]

Salut Robert
Merci pour cette proposition, mais rien ne se passe.
J'ai vu cette fonction, je vais m'en inspirer et essayer de faire quelque chose.
J'ai trouvé une solution avec cette fonction

Set xlwbk = ThisWorkbook
Set Rng = Worksheets("Feuil1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)

With Worksheets("Feuil2").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    .Offset(0, 1).ClearContents
    For Each cell In Rng
    Set Rng1 = .Find(What:=cell, _
                After:=.Cells(.Cells.Count), _
                LookIn:=xlFormulas, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
        If Not Rng1 Is Nothing Then
            FirstAddress = Rng1.Address
            Do
            Rng1.Offset(0, 1).Value = "X"
            Rng1.Interior.ColorIndex = 18
            Set Rng1 = .FindNext(Rng1)
            Loop While Not Rng1 Is Nothing And Rng1.Address <> FirstAddress
        End If
    Next cell
End With

 

[Robert]

Bonjour Hyperion, bonjour le forum,

La flemme de recréer ton environnement pour tester... Un fichier serait le bienvenu.

 

[Bernard_XLD]

Bonjour hyperion, le forum, salut Robert, il y avait longtemps qu'on ne s'étaient croisés sur un fil !

- la Feuil1 contient de A2:A14 la liste des jours fériés en France
- la Feuil2 contient de A2:A23 la liste des jours ouvrés du mois de novembre
Si des dates sont identiques (01/11/2021 et 11/11/2021) pourvoir appliquer une couleur de remplissage aux cellules

@hyperion13 , ou tu peux utiliser cette fonction et plus besoin de tableau de jours fériés
=TJF(date) te renverra un boolean
https://www.excel-downloads.com/threads/automatisme-des-jours-feries.20056501/
tu peux également, si tu préfères, passer ton tableau manuel en tableau automatique.
J'ai mis des exemples pour les MFC, les jours ouvrés, les tableaux matriciels standard horizontaux et verticaux.

Bien cordialement, @+

 

[hyperion13]

Bonjour Hyperion, bonjour le forum,

La flemme de recréer ton environnement pour tester... Un fichier serait le bienvenu.

Salut Robert, salut Yeahou
Robert, effectivement une grosse flemme
Yeahou, j'utilise une fonction JoursFériés depuis des lustres. Affecter une couleur de remplissage si des dates matchaient entre les 2 plages était pour faire simple.
En attache un fichier *.xls qui contient des sub() dans le module ThisWorkbook
@+

 

[Robert]

Re,
Robert le grincheux est content puisque un test lui a permis de voir son erreur. Le code modifié dans le module Module1 :

Sub ComparerDates2()
Dim OD As Worksheet, OM As Worksheet ' déclare les variables OD Onglet Donnees) et OM (Onglet du Mois)
Dim PLD As Range, PLM As Range 'déclare les variables PLD (Plage des Donnees) et PLM (PLage du Mois)
Dim CD As Range, CM As Range 'déclare les variable CM (cellules des Donnees) et CM (Cellule du Mois)

Set OD = Worksheets("donnees") 'définit l'onglet OD
Set OM = Worksheets("nov") 'définit l'onglet OM
Set PLD = OD.Range("A2:A" & OD.Cells(Application.Rows.Count, "A").End(xlUp).Row) 'définit la plage PLD
Set PLM = OM.Range("A2:A" & OM.Cells(Application.Rows.Count, "A").End(xlUp).Row) 'définit la plage PLM
PLM.Interior.ColorIndex = xlNone 'supprime une éventuelle couleur dans la plage PLM
For Each CD In PLD 'boucle 1 : sur toutes les cellule CD de la plge PLD
    For Each CM In PLM 'boucle 2 : sur toutes les cellule CM de la plge PLM
        If CD.Value = CM.Value Then 'condition : si les dates sont identiques
            CM.Interior.ColorIndex = 18: Exit For 'colore la celllule CM et sor de la boucle 2
        End If 'fin de la condition
    Next CM 'prochaine cellule de la boucle 2
Next CD 'prochaine cellule de la boucle 1
End Sub

 

[hyperion13]

Re,
Robert le grincheux est content puisque un test lui a permis de voir son erreur. Le code modifié dans le module Module1

Salut Robert
Merci pour ce retour.
@+