Discussion :

[jeo13]

Bonjour a tous,

J'essaie de controler les dates de plusieurs enregistrements d' un fichier excel.

Dans le fichier excel joint, j' ai deux feuilles:
- une feuille List ou je liste mes enregistrements. Les dates (au format ddmmyy) dans les colonnes E et F sont toujours egales. Idem pour les dates des colonnes G et H.
- et une feuille Calendar: par devise les jours fermes au format.

Ce que je n' arrive pas a faire c' est tout d'abord de verifier que les dates en E, F, G et H ne sont pas dans le calendrier des jours feries pour la devise correspondante en colonne A.

Auriez-vous une ou des pistes d'idees pour commencer?

[Minick]

Salut,

Je crois que tu a perdu ton fichier en route...

[jeo13]

Oups!

Au temps pour moi. Je viens d' updater mon message precedent avec la piece jointe concernee: Lien

Merci encore de s'etre interesse a mon probleme !

[Minick]

Salut,

Un essai a verifier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Option Explicit
 
Sub Test()
    Dim Cptdate As Byte
    Dim CptList As Integer
    Dim Tmp As String, PlageCalDev As String, PlageCalDate As String
    Dim Dates(0 To 1) As Long
    Dim ShtList As Worksheet, ShtCal As Worksheet
 
    Application.ScreenUpdating = False
 
    Set ShtList = Sheets("List")
    Set ShtCal = Sheets("Calendar")
 
    PlageCalDev = "'" & ShtCal.Name & "'!$A2:$A" & ShtCal.Range("A" & ShtCal.Rows.Count).End(xlUp).Row
    PlageCalDate = "'" & ShtCal.Name & "'!$C2:$C" & ShtCal.Range("A" & ShtCal.Rows.Count).End(xlUp).Row
 
    For CptList = 1 To ShtList.Range("A" & ShtList.Rows.Count).End(xlUp).Row
        Tmp = ShtList.Range("E" & CptList).Value
        Dates(0) = CLng("20" & Right(Tmp, 2) & Mid(Tmp, 3, 2) & Left(Tmp, 2))
        Tmp = ShtList.Range("G" & CptList).Value
        Dates(1) = CLng("20" & Right(Tmp, 2) & Mid(Tmp, 3, 2) & Left(Tmp, 2))
 
        For Cptdate = 0 To 1
            While Evaluate("SumProduct((" & PlageCalDev & "=" & Chr(34) & ShtList.Range("A" & CptList).Value & Chr(34) & ")*(" & PlageCalDate & "=" & Dates(Cptdate) & ")*1)") <> 0
                Tmp = CStr(Dates(Cptdate))
                Tmp = CStr(DateValue(Right(Tmp, 2) & "/" & Mid(Tmp, 5, 2) & "/" & Left(Tmp, 4)) + 1)
                Dates(Cptdate) = CLng(Right(Tmp, 4) & Mid(Tmp, 4, 2) & Left(Tmp, 2))
            Wend
            Tmp = CStr(Dates(Cptdate))
            ShtList.Range("E" & CptList & ":F" & CptList).Offset(, Cptdate * 2).Value = CLng(Right(Tmp, 2) & Mid(Tmp, 5, 2) & Mid(Tmp, 3, 2))
        Next Cptdate
    Next CptList
 
    Set ShtList = Nothing
    Set ShtCal = Nothing
 
    Application.ScreenUpdating = True
End Sub

[jeo13]

Salut Minick,

J'ai testé ton code mais il y a quelque chose qui m'échappe dans le while que tu as utilisé et il ne corrige pas une date "fémee".

En fait je ne vois pas à quel moment dans le code on parcoure la liste des jours et quand corrige-t-on les dates si elles figurent dans le calendrier?

[Minick]

Salut,

Effectivement ca ne marche pas avec ton fichier mais dans ton post
original, les dates dans la feuille List etaient au format ddmmyy, contrairement
a ton dernier post ou les dates sont au format yymmdd.

Le principe de la macro:
- On cherche si la date pour la devise est dans calendar (avec un sumproduct)
- si elle y est, on ajoute 1 jour a la date et on refait une recherche dans calendar
- si on ne trouve pas, soit la date d'origine etait bonne et on ne fait rien,
soit la date d'origine a etait modifie et on la remplace dans la feuille list

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Option Explicit
 
Sub Test()
    Dim Cptdate As Byte
    Dim CptList As Integer
    Dim Tmp As String, PlageCalDev As String, PlageCalDate As String
    Dim Dates(0 To 1) As Long
    Dim ShtList As Worksheet, ShtCal As Worksheet
    Dim DateModifiee As Boolean
 
    Application.ScreenUpdating = False
 
    Set ShtList = Sheets("List")
    Set ShtCal = Sheets("Calendar")
 
    PlageCalDev = "'" & ShtCal.Name & "'!$A2:$A" & ShtCal.Range("A" & ShtCal.Rows.Count).End(xlUp).Row
    PlageCalDate = "'" & ShtCal.Name & "'!$C2:$C" & ShtCal.Range("A" & ShtCal.Rows.Count).End(xlUp).Row
 
    For CptList = 1 To ShtList.Range("A" & ShtList.Rows.Count).End(xlUp).Row
        Dates(0) = 20000000 + ShtList.Range("E" & CptList).Value
        Dates(1) = 20000000 + ShtList.Range("G" & CptList).Value
 
        For Cptdate = 0 To 1
            DateModifiee = False
            While Evaluate("SumProduct((" & PlageCalDev & "=" & Chr(34) & ShtList.Range("A" & CptList).Value & Chr(34) & ")*(" & PlageCalDate & "=" & Dates(Cptdate) & ")*1)") <> 0
                Tmp = CStr(Dates(Cptdate))
                Tmp = CStr(DateValue(Right(Tmp, 2) & "/" & Mid(Tmp, 5, 2) & "/" & Left(Tmp, 4)) + 1)
                Dates(Cptdate) = CLng(Right(Tmp, 4) & Mid(Tmp, 4, 2) & Left(Tmp, 2))
                DateModifiee = True
            Wend
            If DateModifiee Then ShtList.Range("E" & CptList & ":F" & CptList).Offset(, Cptdate * 2).Value = Dates(Cptdate) - 20000000
        Next Cptdate
    Next CptList
 
    Set ShtList = Nothing
    Set ShtCal = Nothing
 
    Application.ScreenUpdating = True
End Sub