comparer des cellules avec un critére

[Bricoltou]

Bonsoir le Forum
J'ai encore besoin de votre aide
J'ai un fichier A avec des onglets ( jour de semaine )
et un fichier B avec un seul onglet

Avec votre aide et des adaptations , le code ci dessous compare les cellules de la colonne lundi du fichier B avec une colonne de l'onglet lundi dans le fichier A et ainsi de suite .

Les cellules du fichier A sont coloriés en jaune lorsque j'ai un écart entre les deux ( j'espere avoir été clair )
j'aimerai que ces cellules soit en jaune uniquement lorsque quelles sont supérieur au fichier B et si possible ne signalé que les écart au dessus de dix minutes .
Avez vous des idées ?

Merci d'avance

Bricoltou

Private Sub CdButcoherence_Click()
Dim F1 As Worksheet, F2 As Worksheet, plagehebdo As Range, plagejour As Range
Dim i As Byte, nom1 As Range, nom2 As Range, heure1, heure2
Application.ScreenUpdating = False

On Error Resume Next
Workbooks.Open Filename:=ThisWorkbook.Path & "\Heures_Chauffeurs.xls"
Set F1 = Workbooks("Heures_Chauffeurs.xls").Sheets("semaine")
If F1 Is Nothing Then Exit Sub ' si le fichier ou la feuille n'existent pas
Set plagehebdo = F1.Range("A6:A" & F1.Range("A65536").End(xlUp).Row)
  
Workbooks.Open Filename:=ThisWorkbook.Path & "\Matrice_Chauffeur.xls"
For i = 3 To 8 'boucle sur les 6 jours de la semaine

Set F2 = Workbooks("Matrice_Chauffeur.xls").Sheets(F1.Cells(4, i).Text)
If F2 Is Nothing Then GoTo 1
F2.Unprotect Password:="Terminal"
Set plagejour = F2.Range("B3:B" & F2.Range("B65356").End(xlUp).Row)
F2.Range("U3:U65536").Interior.ColorIndex = xlNone 'efface les couleurs

For Each nom1 In plagehebdo
  heure1 = Format(nom1.Offset(0, 2), "hh:mm")
  For Each nom2 In plagejour
    heure2 = Format(nom2.Offset(0, 19), "hh:mm")
    If nom1 = nom2 And heure1 <> heure2 Then
      nom2.Offset(0, 19).Interior.ColorIndex = 6 'Colorie en Jaune la cellule
      Exit For
    End If
  Next nom2
Next nom1

F2.Protect Password:="Terminal"
1 Next i

ThisWorkbook.Activate

End Sub

 

[kjin]

Re : comparer des cellules avec un critére

Bonsoir,
Je n'ai plus le fichier mais je pense que tu pourrais trouver la solution tout seul ici

For Each nom1 In plagehebdo
 [COLOR="Red"]heure1[/COLOR] = Format(nom1.Offset(0, 2), "hh:mm")
  For Each nom2 In plagejour
    [COLOR="Red"]heure2[/COLOR] = Format(nom2.Offset(0, 19), "hh:mm")
    If nom1 = nom2 And heure1 <> heure2 Then
      nom2.Offset(0, 19).Interior.ColorIndex = 6 'Colorie en Jaune la cellule
      Exit For
    End If
  Next nom2
Next nom1

Il faut pour ça convertir le format de tes heures (il y avait des pb de format si mes souvenir sont bons...), donc pas testé

Dim ecart as Double
ecart = 10 / 1440 'Ecart de 10 mn
'...
For Each nom1 In plagehebdo
 heure1 = CDbl(CDate(Format(nom1.Offset(0, 2), "hh:mm"))) + ecart
  For Each nom2 In plagejour
    heure2 = CDbl(CDate(Format(nom2.Offset(0, 19), "hh:mm")))
    If nom1 = nom2 And heure2 >= heure1 Then
      nom2.Offset(0, 19).Interior.ColorIndex = 6 'Colorie en Jaune la cellule
      Exit For
    End If
  Next nom2
Next nom1
'...

A+
kjin

 

[Bricoltou]

Re : comparer des cellules avec un critére

Bonsoir le Fil , kijn

Kijn , merci pour ton aide , effectivement je ne tenai pas compte du format .
Le code fonctionne partiellement car des cellules vides sont sélectionner en jaune .

Je vais essayer de trouver la solution

Merci pour ton aide
@+

Bricoltou