Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

comparer des cellules avec un critére

Bricoltou

XLDnaute Occasionnel
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

Code:
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

XLDnaute Barbatruc
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
Code:
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é
Code:
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

XLDnaute Occasionnel
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
 

Discussions similaires

Réponses
2
Affichages
327
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…