Problème de dépassement de capacité

**Tiviia** · 13/03/2013, 14h01

Bonjour à tous

J'ai un petit problème avec ma macro.
Ma macro effectue une différence entre deux date en termes d'années, de mois et de jours.

Le code est le suivant:

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
40
41
42
43
44
45
46
 
Function vbaDateDiff(ByVal FirstDateCell As String, ByVal SecondDateCell As String, ByVal StringCode As String) As Long
    dte = FirstDateCell
    dte2 = SecondDateCell
    vbaDateDiff = Application.Evaluate("DATEDIF(DATEVALUE(""" & FirstDateCell & """),DATEVALUE(""" & SecondDateCell & """),""" & StringCode & """)")
End Function
 
Sub t()
 
 'calcul
 Dim test As Range
Dim test23 As Range
Dim diff As Integer
Dim dest As Range
 
Dim jr As Integer
Dim mo As Integer
Dim an As Integer
With ActiveSheet
 
 
    Set test = .Range("J1")
    Set test23 = .Range("AH1")
    Set dest = .Range("AQ1")
    For i = 0 To .Columns(1).Find("TH*", , , , xlByColumns, xlPrevious).Row - 1
        If IsDate(test.Offset(i, 0)) Then
            diff = test.Offset(i, 0) - test23.Offset(i, 0)
            If diff <= 0 Then
                jr = vbaDateDiff(Format(test.Offset(i, 0), "mm/dd/yyyy"), Format(test23.Offset(i, 0), "mm/dd/yyyy"), "md")
                mo = vbaDateDiff(Format(test.Offset(i, 0), "mm/dd/yyyy"), Format(test23.Offset(i, 0), "mm/dd/yyyy"), "ym")
                an = vbaDateDiff(Format(test.Offset(i, 0), "mm/dd/yyyy"), Format(test23.Offset(i, 0), "mm/dd/yyyy"), "y")
                dest.Offset(i, 0) = an
                dest.Offset(i, 1) = mo
                dest.Offset(i, 2) = jr
            Else
                jr = vbaDateDiff(Format(test23.Offset(i, 0), "mm/dd/yyyy"), Format(test.Offset(i, 0), "mm/dd/yyyy"), "md")
               mo = vbaDateDiff(Format(test23.Offset(i, 0), "mm/dd/yyyy"), Format(test.Offset(i, 0), "mm/dd/yyyy"), "ym")
               an = vbaDateDiff(Format(test23.Offset(i, 0), "mm/dd/yyyy"), Format(test.Offset(i, 0), "mm/dd/yyyy"), "y")
                 dest.Offset(i, 0) = an
                dest.Offset(i, 1) = mo
              dest.Offset(i, 2) = jr
        End If
        End If
    Next i
End With
End Sub

Lorsque j'exécute la macro j'ai un message d'erreur me disant qu'il y a un dépassement de capacité.

Je constate que quand je supprime dans la colonne de J les dates de l'année 1900, la macro fonctionne. Le problème est que les données que je supprime sont indispensables.

Pouvez-vous m'aider s'il vous plait?

Cdt
Tiviia

**Kimy_Ire** · 13/03/2013, 14h21

Je n'ai pas regardé en profondeur. Cependant avec ton message d'erreur :

=> remplace tous tes "Integer" par des "Long" ou des "Double" et dis moi si le problème persiste !

**Tiviia** · 13/03/2013, 14h30

Bonjour Kimy_Ire

Lorsque je remplace par les "INTEGER" par "DOUBLE" Ou "Long"; j'ai un message erreur de compatibilité

...

.

Je ne sais plus quoi faire

**danixdb** · 13/03/2013, 14h54

Bonjour Tiviia, Kimy_ire, le Forum,

La piste indiquée par Kimy_Ire me parait bonne, j'ai juste remplacer :

Diff as integer
par
Diff as double

et cela ne provoque pas d'erreur d'exécution.

Slts

**Theze** · 13/03/2013, 14h55

Bonjour,

C'est probablement dû à une incompatibilité de type. Essai comme ceci :

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
40
41
42
43
44
45
Function vbaDateDiff(ByVal FirstDateCell As Long, ByVal SecondDateCell As Long, ByVal StringCode As String) As Long
 
    vbaDateDiff = DateDiff(StringCode, FirstDateCell, SecondDateCell)
 
End Function
 
Sub t()
 
Dim Test As Range
Dim test23 As Range
Dim diff As Long
Dim dest As Range
 
Dim jr As Long
Dim mo As Long
Dim an As Long
Dim I As Long
 
    With ActiveSheet
 
        Set Test = .Range("J1")
        Set test23 = .Range("AH1")
        Set dest = .Range("AQ1")
 
        For I = 0 To .Columns(1).Find("TH*", , , , xlByColumns, xlPrevious).Row - 1
 
            If IsDate(Test.Offset(I, 0)) Then
 
                diff = CLng(Test.Offset(I, 0)) - CLng(test23.Offset(I, 0))
 
                jr = IIf(diff <= 0, vbaDateDiff(Test.Offset(I, 0), test23.Offset(I, 0), "d"), vbaDateDiff(test23.Offset(I, 0), Test.Offset(I, 0), "d"))
                mo = IIf(diff <= 0, vbaDateDiff(Test.Offset(I, 0), test23.Offset(I, 0), "m"), vbaDateDiff(test23.Offset(I, 0), Test.Offset(I, 0), "m"))
                an = IIf(diff <= 0, vbaDateDiff(Test.Offset(I, 0), test23.Offset(I, 0), "yyyy"), vbaDateDiff(test23.Offset(I, 0), Test.Offset(I, 0), "yyyy"))
 
                dest.Offset(I, 0) = an
                dest.Offset(I, 1) = mo
                dest.Offset(I, 2) = jr
 
            End If
 
        Next I
 
    End With
 
End Sub

Hervé.

Re,

Pas rafraîchi mais Kimy_Ire effectivement mis le doigt dessus le problème ;o)

Hervé.

**Tiviia** · 13/03/2013, 15h18

Bonjour

Je vous remercie m'avoir répondu

.

Theze, je viens de tester ton code. Il s'exécute sans erreurs, mais quand j'analyse les résultats je constate que la macro calcul la différence entre deux date avec des unités de temps différents (années, mois, jours),c'est le même résultat dans des unités de temps différents.

Mais je veux avoir le résultat en année mois jours.

Par exemple: la différence entre le 02/03/2012 et 01/02/2013 est 1 an 1 mois 1 jour.

**Theze** · 14/03/2013, 17h18

Bonjour,

Voilà qui, je crois, devrait te convenir :

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
40
41
42
43
44
45
46
 
Function vbaDateDiff(FirstDateCell As Long, SecondDateCell As Long, StringCode As String) As Long
 
    Dim Temp As Long
 
    'inverse les valeurs si nécessaire
    If FirstDateCell > SecondDateCell Then
 
        Temp = FirstDateCell
        FirstDateCell = SecondDateCell
        SecondDateCell = Temp
 
    End If
 
    vbaDateDiff = Application.Evaluate("DATEDIF(" & FirstDateCell & "," & SecondDateCell & ",""" & StringCode & """)")
 
End Function
 
Sub t()
 
Dim test As Range
Dim test23 As Range
Dim dest As Range
Dim I As Long
 
    With ActiveSheet
 
        Set test = .Range("J1")
        Set test23 = .Range("K1")
        Set dest = .Range("M1")
 
        For I = 0 To .Columns(1).Find("TH*", , , , xlByColumns, xlPrevious).Row - 1
 
            If IsDate(test.Offset(I, 0)) Then
 
                dest.Offset(I, 2) = vbaDateDiff(test.Offset(I, 0), test23.Offset(I, 0), "md")
                dest.Offset(I, 1) = vbaDateDiff(test.Offset(I, 0), test23.Offset(I, 0), "ym")
                dest.Offset(I, 0) = vbaDateDiff(test.Offset(I, 0), test23.Offset(I, 0), "y")
 
            End If
 
        Next I
 
    End With
 
End Sub

Hervé.

**Tiviia** · 15/03/2013, 13h16

Bonjour Theze

Dans un premier temps, je te remercie infiniment de l'aide que tu m'a apporté.

Ton code fonctionne

!!

C'est génial !

Je remercie également les autres qui ont participé à la discussion!

Un GRAND MERCI à TOUS !

Cdt
Tiviia

**Tiviia** · 20/03/2013, 12h49

Bonjour à tous

Avec le code suivant je peux calculer la différence entre deux dates en année, mois et jours.

Je viens de constater que j'ai des valeurs négatives de jours.

Comment faire pour ne plus avoir ce problème??

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
40
41
42
43
44
45
Function vbaDateDiff(FirstDateCell As Long, SecondDateCell As Long, StringCode As String) As Long
 
    Dim Temp As Long
 
    'inverse les valeurs si nécessaire
    If FirstDateCell > SecondDateCell Then
 
        Temp = FirstDateCell
        FirstDateCell = SecondDateCell
        SecondDateCell = Temp
 
    End If
 
    vbaDateDiff = Application.Evaluate("DATEDIF(" & FirstDateCell & "," & SecondDateCell & ",""" & StringCode & """)")
 
End Function
 
Sub t()
 
Dim test As Range
Dim test23 As Range
Dim dest As Range
Dim I As Long
 
    With ActiveSheet
 
        Set test = .Range("J1")
        Set test23 = .Range("K1")
        Set dest = .Range("M1")
 
        For I = 0 To .Columns(1).Find("TH*", , , , xlByColumns, xlPrevious).Row - 1
 
            If IsDate(test.Offset(I, 0)) Then
 
                dest.Offset(I, 2) = vbaDateDiff(test.Offset(I, 0), test23.Offset(I, 0), "md")
                dest.Offset(I, 1) = vbaDateDiff(test.Offset(I, 0), test23.Offset(I, 0), "ym")
                dest.Offset(I, 0) = vbaDateDiff(test.Offset(I, 0), test23.Offset(I, 0), "y")
 
            End If
 
        Next I
 
    End With
 
End Sub

Cdt
Tiviia

**Theze** · 20/03/2013, 14h24

Bonjour,

Sur quelles dates par exemple car à partir de ton classeur test, je n'ai constaté aucune différence de jour en négatif ?
As-tu testé avec la fonction DATEDIF() dans Excel comme ci-dessous par exemple ?

Code :

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

1
2
 
=DATEDIF(J2;L2;"md")

Hervé.

**Tiviia** · 20/03/2013, 14h50

Bonjour

Oui j'ai testé manuellement; je trouve toujours des valeurs négatives de jours.

Voila un nouveau fichier.
Il faut appliquer un autofiltre pour voir les valeurs négatives de jours.

Cdt

Tiviia

PS: j'ai gardé les mêmes colonnes du code.

**Theze** · 20/03/2013, 15h23

Re,

Alors, modifie la fonction de façon à avoir 0 :

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
 
Function vbaDateDiff(FirstDateCell As Long, SecondDateCell As Long, StringCode As String) As Long
 
    Dim Temp As Long
    Dim LaDate As Long
 
    'inverse les valeurs si nécessaire
    If FirstDateCell > SecondDateCell Then
 
        Temp = FirstDateCell
        FirstDateCell = SecondDateCell
        SecondDateCell = Temp
 
    End If
 
    LaDate = Application.Evaluate("DATEDIF(" & FirstDateCell & "," & SecondDateCell & ",""" & StringCode & """)")
 
    If LaDate < 0 Then LaDate = 0
 
    vbaDateDiff = LaDate
 
End Function

Hervé.

**Tiviia** · 20/03/2013, 16h56

Merci hervé !

Problème de dépassement de capacité [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager