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

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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
 
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
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
735
Réponses
5
Affichages
913
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
1 K
Réponses
16
Affichages
2 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…