Erreur '6' Dépassement de capacité

Résolu/Fermé

TraderAS Messages postés 110 Date d'inscription lundi 3 décembre 2012 Statut Membre Dernière intervention 26 avril 2018 - 10 avril 2013 à 12:44
TraderAS Messages postés 110 Date d'inscription lundi 3 décembre 2012 Statut Membre Dernière intervention 26 avril 2018 - 11 avril 2013 à 15:11

Bonjour,

Je souhaite insérer automatiquement les dates manquantes voici le fichier excel sur lequel je travail: https://www.cjoint.com/c/CDiosKpPr2C

une personne m'a aidé à avoir ce code sauf que he trouve lors de l'éxecution de ce code Erreur '6' Dépassement de capacité
voici le code
Option Explicit

Sub Remplissage()
Dim LastLig As Long, i As Long, j As Long, k As Long, m As Long
Dim n As Integer
Dim Tb, Res()

Application.ScreenUpdating = False
With Worksheets("Test")
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
Tb = .Range("A2:B" & LastLig)

ReDim Res(1 To 2, 1 To 1)
Res(1, 1) = CLng(Tb(1, 1))
Res(2, 1) = Tb(1, 2)
j = 1
For i = 2 To LastLig - 1
n = Diff(Tb, i)
m = j + n
ReDim Preserve Res(1 To 2, 1 To m)
For k = j + 1 To m
Res(1, k) = Suiv(Res(1, k - 1))
Res(2, k) = IIf(n = 1 Or k = m, Tb(i, 2), Tb(i - 1, 2))
Next k
j = m
Next i
With .Range("B2")
.Resize(j, 2) = Application.Transpose(Res)
.Resize(j, 1).NumberFormat = "dd/mm/yyyy"
End With
End With
End Sub

Private Function Diff(ByVal T, ByVal d As Long) As Byte
Dim Dte As Long, Der As Long

Der = CLng(T(d - 1, 1))
Dte = CLng(T(d, 1))

Diff = Evaluate("=NETWORKDAYS(" & Der & "," & Dte & ")") - 1

End Function

Private Function Suiv(ByVal Dte As Long) As Long

Suiv = Evaluate("=WORKDAY(" & Dte & ",1)")
End Function

merci

A voir également:

Erreur '6' Dépassement de capacité
Erreur 0x80070643 - Accueil - Windows
Gta 6 prix - Accueil - Jeu vidéo
Erreur 0x80070643 Windows 10 : comment résoudre le problème de la mise à jour KB5001716 - Accueil - Windows
Le fichier contient une liste de prénoms. triez ce tableau par ordre alphabétique des prénoms. quel mot est formé par les 6 premières lettres de la colonne code ? - Forum Bureautique
Paris multiple 2/6 explication ✓ - Forum Loisirs / Divertissements

3 réponses

Réponse 1 / 3

pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 643
10 avril 2013 à 14:04

Bonjour,

Sans vraiment comprendre le calcul je relève deux anomalies dans la fonction Diff.

Voici les deux corrections en gras :
Private Function Diff(ByVal T, ByVal d As Long) As Long
Dim Dte As Long, Der As Long
Der = CLng(T(d - 1, 1))
Dte = CLng(T(d, 1))
Diff = Evaluate("=NETWORKDAYS(" & Dte & "," & Der & ")") - 1
End Function

Je ne sais pas si c'est normal mais il tentait de calculer des nombres de jours négatifs (sans doute parce que les dates sont en ordre décroissant).

A voir si le résultat est bon

A+

TraderAS Messages postés 110 Date d'inscription lundi 3 décembre 2012 Statut Membre Dernière intervention 26 avril 2018 1
10 avril 2013 à 14:10

Salut pilas 31,
effectivement on essaye de faire la différence entre deux dates, qui sont supposées être ordonnées par ordre croissant

pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 643
10 avril 2013 à 14:19

D'accord. d'où l'inversion de Dte et Der. En fait quand le résultat est négatif il y dépassement de capacité du format Byte.

TraderAS Messages postés 110 Date d'inscription lundi 3 décembre 2012 Statut Membre Dernière intervention 26 avril 2018 1
10 avril 2013 à 14:28

Voila, mais bon quand j'ai appliqué le code ca marché avec votre correction, mais le résultat n'est pas le résultat souhaité, en faite je veux insérer les lignes des dates manquante dans l'historique que j'ai :

comme suit:
DATE Valeur
20/03/2011 10
18/03/2011 15
16/03/2011 13
14/03/2011 12

comme vous pouvez le constatez il manque les dates du 19,17 et le 15 Mars 2013, je souhaite les insérer automatiquement et copier coller la valeur de la date qui précéde c'est à dire et comme exemple:

===>j'insére la ligne de la date du 19/03/2013 et je fais un copier coller de la valeur du 18/03/2013 et ains de suite

j'ai crée cee code mais ca n'a pas marché :

Sub date_creation()
Dim i As Integer
Dim fin As Integer

For i = 1 To 10
If Cells(i, 1) = "" Then fin = i: Exit For
Next i

For i = 1 To fin
If Cells(i + 1, 1) <> SERIE.JOUR.OUVR(Cells(i, 1).Value, 1) Then
Rows(i + 1).Insert
Cells(i + 1, 1) = Cells(i, 1) + 1
End If
Next i
End Sub

==> Erreur d'éxecution '424' objet recquis au niveau de cette ligne:
****If Cells(i + 1, 1) <> SERIE.JOUR.OUVR(Cells(i, 1).Value, 1) Then****
vu que je travail sur une semaine de 5 jours

et voici le document sur lequel je travail :

https://www.cjoint.com/c/CDiosKpPr2C

est ce que vous pouvez me donnez un coup de main a avoir le bon résultat

merci

pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 643
10 avril 2013 à 14:50

OK je regarde.

TraderAS Messages postés 110 Date d'inscription lundi 3 décembre 2012 Statut Membre Dernière intervention 26 avril 2018 1
10 avril 2013 à 14:51

Merci

Réponse 2 / 3

pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 643
Modifié par pilas31 le 10/04/2013 à 16:39

Voici une solution inspiré de la macro date_création

Sub date_creation()
Dim i As Integer
Dim fin As Integer

fin = Cells(Rows.Count, 1).End(xlUp).Row
For i = fin - 1 To 1 Step -1
    If Cells(i + 1, 1) <> WorksheetFunction.WorkDay(Cells(i, 1).Value, 1) Then
        Rows(i + 1).Insert
        Cells(i + 1, 1) = WorksheetFunction.WorkDay(Cells(i, 1).Value, 1)
        Cells(i + 1, 2) = Cells(i, 2)
        i = i + 2
    End If
Next i
End Sub

EDIT: après test je viens de corriger une erreur et de modifier la macro qui ne marchait pas bien lorsque plusieurs jours consécutifs manquaient

Trois remarques :
1/ il faut que les dates soient en ordre croissant
2/ cela ne tient pas compte des jours fériés.
3/ attention la liste initiale ne doit comporter que des jours ouvrés sinon le comportement est incorrect.

Cordialement,

Réponse 3 / 3

TraderAS Messages postés 110 Date d'inscription lundi 3 décembre 2012 Statut Membre Dernière intervention 26 avril 2018 1
11 avril 2013 à 10:02

Bonjour,

j'ai appliqué le code, il a tourné sans aucune lilite d'arrêt voici le fichier surlequel j'ai travaillé, les 3 conditions que vous avez imposées sont respectées mais le code ne fait que tourner

voici le fichier: https://www.cjoint.com/?CDlkaOxBDcM

pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 643
11 avril 2013 à 10:57

Bonjour,

Je crois que je me suis mal exprimé, les dates doivent être en ordre croissant c'est à dire la plus ancienne date en A1 d'abord vers la date la plus récente. Si vous re-triez votre colonne dans cet ordre cela fonctionne.

Si vous souhaitez que cela puisse fonctionner dans l'ordre inverse je peux modifier le code.

Cordialement,

TraderAS Messages postés 110 Date d'inscription lundi 3 décembre 2012 Statut Membre Dernière intervention 26 avril 2018 1
Modifié par TraderAS le 11/04/2013 à 12:27

Re

voici le code, et ca marche mais seulement pour un nombre limité de lignes à modifier

Sub date_creation()
Dim i As Integer
Dim fin As Integer

fin = Cells(Rows.Count, 1).End(xlUp).Row
For i = fin To 2 Step -1
If Cells(i - 1, 1) <> WorksheetFunction.WorkDay(Cells(i, 1).Value, 1) Then
Rows(i).Insert
Cells(i, 1) = WorksheetFunction.WorkDay(Cells(i + 1, 1).Value, 1)
Cells(i, 2) = Cells(i + 1, 2)
i = i + 1
End If
Next i
End Sub

Quand j'ai voulu testé ca n'a marché que sur une plage de données qui composée de presque 20 lignes mais quand j'ai essayé de l'appliquer sur des données composées de presque 300 lignes, et où il manque des dates, il a commencé à m'ajouter des dates futures, au dela de 2013, c'est à dire il a ajouté les dates de 2014, 2015 etc

il manque une petite rectif afin de limiter son champs d'action qu'à seulement les données disponibles ni plus ni moin peut être une variable k qui varie entre 1 et le nombre de lignes

ci joint le fichier qui contient un grand nombre de lignes

Merci pour votre précieuse aide ;)

pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 643
11 avril 2013 à 15:06

Voila une correction à tester :

Sub date_creation()
Dim i As Integer
Dim fin As Integer

fin = Cells(Rows.Count, 1).End(xlUp).Row
For i = fin To 3 Step -1
 If Cells(i - 1, 1) <> WorksheetFunction.WorkDay(Cells(i, 1).Value, 1) Then
 Rows(i).Insert
 Cells(i, 1) = WorksheetFunction.WorkDay(Cells(i - 1, 1).Value, -1)
 Cells(i, 2) = Cells(i - 1, 2)
 i = i + 1
 End If
Next i
End Sub

TraderAS Messages postés 110 Date d'inscription lundi 3 décembre 2012 Statut Membre Dernière intervention 26 avril 2018 1
11 avril 2013 à 15:11

Ca marche pilas ;)
vraiment merci pour votre préciseuse aide

Discussions similaires

Belote à 6 joueurs

"AMD a détecté un dépassement de délai du pilote"

Instagram "Désolé, une erreur s'est produite"

Erreur de lecture sur iptv smarters

Règle du jeu