Erreur '6' Dépassement de capacité

Résolu

TraderAS Messages postés 110 Date d'inscription Statut Membre Dernière intervention -
TraderAS Messages postés 110 Date d'inscription Statut Membre Dernière intervention - 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

Afficher la suite

A voir également:

Erreur '6' Dépassement de capacité
Nero 6 - Télécharger - Gravure
Dans la table des matières du document à télécharger, le chapitre 6 et ses 2 sections n'apparaissent pas. trouvez l'erreur dans la structure du document et corrigez-la. mettez à jour la table des matières. quel est le mot formé par les lettres en majuscules de la table des matières après sa mise à jour ? - Forum Word
Belote a 6 - Forum Graphisme
Le logiciel amd a détecté un dépassement de délai du pilote - Forum Carte graphique
Gta 6 trailer 2 - Guide

3 réponses

Réponse 1 / 3

pilas31 Messages postés 1825 Date d'inscription Statut Contributeur Dernière intervention 646

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 Statut Membre Dernière intervention 1

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 Statut Contributeur Dernière intervention 646

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 Statut Membre Dernière intervention 1

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 Statut Contributeur Dernière intervention 646

OK je regarde.

TraderAS Messages postés 110 Date d'inscription Statut Membre Dernière intervention 1

Merci

Réponse 2 / 3

pilas31 Messages postés 1825 Date d'inscription Statut Contributeur Dernière intervention 646

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 Statut Membre Dernière intervention 1

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 Statut Contributeur Dernière intervention 646

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 Statut Membre Dernière intervention 1

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 Statut Contributeur Dernière intervention 646

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 Statut Membre Dernière intervention 1

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"

Règle du jeu

Erreur 3005 sur France TV

Paris multiple : explications de 2/3, 3/4, 2/4, 2/5, etc.

Votre réponse

Discussions similaires