XL 2019 comparaison de date VBA

douguy · 30 Avril 2021

Bonjour le forum.
Nouveau problème pour moi dans une macro
Je déclare une cellule comme date pivot et cherche à comparer les dates contenues dans une plage à cette date
Ls résultat sont aléatoires. quand je vérifie la valeur de closuredate le format est 05:05:21
Est ce normal (je pense qu'on devrait avoir 05.05.21)
du coup déclaration de closuredate as date : ca devrait être 05/05/21

une idée pour que mes comparaisons se fasse ?

Public Sub CheckIsPastOrFuture()
On Error Resume Next
Dim closureDate As Date
Dim i As Double

' recuperation de la date de cloture en B2 dans res fcst (apres suppression de toutes les colonnes))
closureDate = CDate(sh_res_fcst.Cells(2, 2).Value)
i = 2
' parcours de l'onglet data, check et affichage
With sh_data
While (Not IsEmpty (.Cells(i, 2))))
If (CDate(.Cells(i, 2).Value) < closureDate) Then
.Cells(i, 6).Value = "Past"
Else
.Cells(i, 6).Value = "Future"
End If
i = i + 1
Wend
End With
End Sub

Phil69970 · 30 Avril 2021

Bonjour @douguy

1)Ton code ne peut pas fonctionner en l'état car il y a une erreur sur cette ligne

VB:

While (Not IsEmpty (.Cells(i, 2))))

Il y a une parenthèse en trop à la fin

2)Peut on modifier la colonne qui contient la date avec des points 05.05.21 et la transformer en "date classique" 05/05/21 si oui et en admettant que se soit la colonne C je te propose ce code pour transformer les "." en "/"

Code:

Sub TransformeDate()
Dim Derlig&
Derlig = Range("A" & Rows.Count).End(xlUp).Row
Range("C2:C" & Derlig).TextToColumns Destination:=Range("C2"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 4), TrailingMinusNumbers:=True
End Sub

De plus je pense que ton code doit être atrocement long

Un petit fichier exemple permettrait de l’accélérer..... avec quelques explications sur ce que tu veux faire. Sur quelle feuille tu veux travailler ? (res_stat, res_fcst, sh.data, une autre ...... ? )
A priori, rajouter "Past" ou "Future" dans la colonne F si j'ai compris (A confirmer) si la date en colonne C (?) est supérieur ou non à la colonne B

@Phil69970

Phil69970 · 30 Avril 2021

@douguy

Complétement à l'aveugle je te propose ceci vraisemblablement quelques adaptations seront nécessaire:

1) On transforme les "dates"

VB:

Sub TransformeDate()
Dim Derlig&
With sh_res_fcst
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row
    '<== a adapter
    .Range("B2:B" & Derlig).TextToColumns Destination:=.Range("B2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
End With
End Sub

2)On compare les dates et on met "Past" ou "Future"

VB:

Sub TestDate()
Application.ScreenUpdating = False
Dim Derlig&, i&
'TransformeDate
With sh_Data
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To Derlig
    'compare date entre onglet sh_res_fcst et sh_data
    'dans feuille data mettre Past si date sh_data est < à sh_res_fcst
        If .Range("B" & i) < sh_res_fcst.Range("B" & i) Then    '<== a adapter
            .Range("F" & i).Value = "Past"                      '<== a adapter
        Else
            .Range("F" & i).Value = "Future"                    '<== a adapter
        End If
    Next i
End With
End Sub

3)Et le tout ensemble....

Code:

Sub TransformeDate()
Dim Derlig&
With sh_res_fcst
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row
    '<== a adapter
    .Range("B2:B" & Derlig).TextToColumns Destination:=.Range("B2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
End With
End Sub

Sub TestDate() 'Public Sub CheckIsPastOrFuture()
Application.ScreenUpdating = False
Dim Derlig&, i&
TransformeDate
With sh_Data
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To Derlig
    'compare date entre onglet sh_res_fcst et sh_data
    'dans feuille data mettre Past si date sh_data est < à sh_res_fcst
        If .Range("B" & i) < sh_res_fcst.Range("B" & i) Then    '<== a adapter
            .Range("F" & i).Value = "Past"                      '<== a adapter
        Else
            .Range("F" & i).Value = "Future"                    '<== a adapter
        End If
    Next i
End With
End Sub

On lance juste "Test Date" par un bouton par exemple et tout ce fait d'un seul coup, la transformation des dates et la comparaison des dates avec "Past" et "Future".

Regarde si besoin des adaptations éventuelles.

Merci de ton retour
@Phil69970

douguy · 3 Mai 2021

Bonjour @Phil69970

Tu es au top ! merci beaucoup !
j'ai fait les adaptations. Ca m'a tout l'air de bien fonctionner.
J'ai juste eu besoin de changer

If .Range("B" & i) < sh_res_fcst.Range("B" & i) Then '<== a adapter

par

If .Range("B" & i) < sh_res_fcst.Range("B2") Then '<== a adapter

Encore merci

Phil69970 · 3 Mai 2021

@douguy

Très bien si tout est ok

@Phil69970

XL 2019 comparaison de date VBA

douguy

XLDnaute Junior

Phil69970

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

douguy

XLDnaute Junior

Phil69970

XLDnaute Barbatruc

Discussions similaires