Aide VBA
Dernière réponse : dans Programmation
Bonjour,
J'essaie, tant bien que mal, de trouver une solution au problème suivant:
Je dispose d'un tableau Excel dans lequel j'ai une colonne date et une colonne montant (parmi d'autres ^^)
je souhaite que lorsque l'on compare la date de la colonne date avec une date stocké dans y et que la condition est respectée, il retienne la ligne et aille me copier la cellule de la colonne "montant" située sur cette même ligne dans un autre cellule d'une autre feuille.
Suis-je clair ?
j'ai réussi à exprimer la logique via et à donner mes conditions via
Select case....
Case...
...
End select
Mon code ne bug pas... mais il ne copie rien !!!!
un code inutile quoi !!
il y aurais t'il une âme charitable qui veuille bien m'éclairer ?
ci dessous le code
(je pense que ma méthode de copie n'est pas bonne.. mais en utilisant Range, rien ne se passe non plus...du moins, quand c'est moi qui les utilise ^^)
J'essaie, tant bien que mal, de trouver une solution au problème suivant:
Je dispose d'un tableau Excel dans lequel j'ai une colonne date et une colonne montant (parmi d'autres ^^)
je souhaite que lorsque l'on compare la date de la colonne date avec une date stocké dans y et que la condition est respectée, il retienne la ligne et aille me copier la cellule de la colonne "montant" située sur cette même ligne dans un autre cellule d'une autre feuille.
Suis-je clair ?
j'ai réussi à exprimer la logique via et à donner mes conditions via
Select case....
Case...
...
End select
Mon code ne bug pas... mais il ne copie rien !!!!
un code inutile quoi !!
il y aurais t'il une âme charitable qui veuille bien m'éclairer ?
ci dessous le code
(je pense que ma méthode de copie n'est pas bonne.. mais en utilisant Range, rien ne se passe non plus...du moins, quand c'est moi qui les utilise ^^)
Dim A, D, R As Worksheet
Dim I, J, K, L As Date
Dim g, e, h As Long
Dim iD, iA As Long
Set A = Worksheets("Age Analysis")
Set R = Worksheets("Results")
iA = 1
g = 0
h = 0
I = DateAdd("m", -3, y)
J = DateAdd("m", -6, y)
K = DateAdd("m", -9, y)
L = DateAdd("m", -12, y)
Select Case I & J & K & L
Case ActiveSheet.Cells(iD, 7).Value >= I
Cells(iD, 13).Value.Select
Selection.Copy
A.Cells(iA, 1).Paste
A.Cells(iA, 1).Value = e
g = g e 'g permet de stocker la somme
h = h 1 'compte le nombre d'operations passe entre les dates definies
iA = iA 1
R.Cells(10, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
R.Cells(10, 5).Value = h 'affiche le nombre d'opérations dans la cellulle de la feuille results
Case I > ActiveSheet.Cells(iD, 7).Value >= J
Cells(iD, 13).Value.Select
Selection.Copy
A.Cells(iA, 1).Paste
A.Cells(iA, 1).Value = e
g = g e 'g permet de stocker la somme
h = h 1 'compte le nombre d'operations passe entre les dates definies
iA = iA 1
R.Cells(9, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
R.Cells(9, 5).Value = h 'affiche le nombre d'opérations dans la cellulle de la feuille results
etc....
End Select
Next
Autres pages sur : aide vba
Lassé par la pub ? Créez un compte
Meilleure solution
Bon, ben faut regarder la ligne juste au dessus:
J'ai fait une petite coquille dans mon premier code, tu l'as corrigée, mais mal
Il ne faut pas regarder dans Rows() - c'est-à-dire dans les lignes de la feuille en cours - mais dans row_source, la ligne que l'on veut scruter
Aïe, aïe, aïe !!!
For Each row_source In ws_source.Rows [..] ' // Select Case Rows.Cells(dc_colnum).Value Select Case row_source.Cells(dc_colnum).Value
J'ai fait une petite coquille dans mon premier code, tu l'as corrigée, mais mal
Il ne faut pas regarder dans Rows() - c'est-à-dire dans les lignes de la feuille en cours - mais dans row_source, la ligne que l'on veut scruter
salut zeb,
, je m'en doutais !!!
en effet je n'avais pas vu que mon code avait été modifié lorsque je l'ai posté....
j'ai un peu avancé (enlever quelques trucs horribles tel les .paste !!!)
voici donc le code. (je le poste en entier cette fois ci.. quitte a prendre une page:
voilà, je pense que cette fois ci le code s'est affiché correctement.
Citation :
Il semble y avoir à la fois de très bonnes choses là-dedans, et de très mauvaises.
en effet je n'avais pas vu que mon code avait été modifié lorsque je l'ai posté....
j'ai un peu avancé (enlever quelques trucs horribles tel les .paste !!!)
voici donc le code. (je le poste en entier cette fois ci.. quitte a prendre une page:
Dim A, D, R As Worksheet
Dim I, J, K, L As Date
Dim g, e, h As Long
Dim iD, iA As Long
Set A = Worksheets("Age Analysis")
Set R = Worksheets("Results")
iA = 1
g = 0
h = 0
I = DateAdd("m", -3, y)
J = DateAdd("m", -6, y)
K = DateAdd("m", -9, y)
L = DateAdd("m", -12, y)
Sheets("Debit").Select
For iD = 2 To 65536
Select Case I & J & K & L
Case ActiveSheet.Cells(iD, 7).Value >= I
ActiveSheet.Range(iD & ";" & 13).Copy A.Cells(iA, 1)
e = A.Cells(iA, 1)
g = g + e 'g permet de stocker la somme
h = h + 1 'compte le nombre d'operations passe entre les dates definies
iA = iA + 1
R.Cells(10, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
R.Cells(10, 5).Value = h 'affiche le nombre de date dans la cellulle de la feuille results
Case I > ActiveSheet.Cells(iD, 7).Value >= J
ActiveSheet.Range(iD & ";" & 13).Copy A.Cells(iA, 1)
e = A.Cells(iA, 1)
g = g + e 'g permet de stocker la somme
h = h + 1 'compte le nombre d'operations passe entre les dates definies
iA = iA + 1
R.Cells(9, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
R.Cells(9, 5).Value = h 'affiche le nombre de date dans la cellulle de la feuille results
Case J > ActiveSheet.Cells(iD, 7).Value >= K
ActiveSheet.Range(iD & ";" & 13).Copy A.Cells(iA, 1)
e = A.Cells(iA, 1)
g = g + e 'g permet de stocker la somme
h = h + 1 'compte le nombre d'operations passe entre les dates definies
iA = iA + 1
R.Cells(8, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
R.Cells(8, 5).Value = h 'affiche le nombre de date dans la cellulle de la feuille results
Case K > ActiveSheet.Cells(iD, 7).Value >= L
ActiveSheet.Range(iD & ";" & 13).Copy A.Cells(iA, 1)
e = A.Cells(iA, 1)
g = g + e 'g permet de stocker la somme
h = h + 1 'compte le nombre d'operations passe entre les dates definies
iA = iA + 1
R.Cells(7, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
R.Cells(7, 5).Value = h 'affiche le nombre de date dans la cellulle de la feuille results
Case ActiveSheet.Cells(iD, 7).Value < L
ActiveSheet.Range(iD & ";" & 13).Copy A.Cells(iA, 1)
e = A.Cells(iA, 1)
g = g + e 'g permet de stocker la somme
h = h + 1 'compte le nombre d'operations passe entre les dates definies
iA = iA + 1
R.Cells(6, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
R.Cells(6, 5).Value = h 'affiche le nombre de date dans la cellulle de la feuille results
End Select
Next
voilà, je pense que cette fois ci le code s'est affiché correctement.
Yep, maintenant, on va pouvoir t'aider.
Alors d'abord, ligne 7 et 8, c'est très bien. Ainsi on pourra faire référence à nos deux feuilles. Sauf que ligne 21, au lieu de faire pareil, tu préfères activer la feuille "D" plutôt que de rester sur la même logique. Dommage. A chaque fois que je vois un Selection et/ou un ActiveTruc, ça me hérisse le poil.
Ensuite, entre chaque clause Case, tu réécris la même chose, à une toute petite et légère différence.
Puis il va falloir réviser le fontionnement de Select Case. Mais on verra ça après.
Factorisons ton code :
Donc c'est factorisé, j'ai ajouté deux/trois bricoles pour faire joli.
Mais ça ne marche toujours pas.
Ben non ! C'est quoi ce massacre au Select Case ?
Tiens, juste pour le plaisir, affiche ta ligne 23 :
Voici la bonne syntaxe :
A part qu'on voit tout de suite qu'il faut prendre le problème à l'envers :
Ton code devient :
EDIT: relire la ligne 23.
Alors d'abord, ligne 7 et 8, c'est très bien. Ainsi on pourra faire référence à nos deux feuilles. Sauf que ligne 21, au lieu de faire pareil, tu préfères activer la feuille "D" plutôt que de rester sur la même logique. Dommage. A chaque fois que je vois un Selection et/ou un ActiveTruc, ça me hérisse le poil.
Ensuite, entre chaque clause Case, tu réécris la même chose, à une toute petite et légère différence.
Puis il va falloir réviser le fontionnement de Select Case. Mais on verra ça après.
Factorisons ton code :
Dim A, D, R As Worksheet Dim I, J, K, L As Date Dim g, e, h As Long Dim iD, iA As Long Dim ligne As Long Set A = Worksheets("Age Analysis" ) Set R = Worksheets("Results" ) Set D = Worksheets("Debit" ) iA = 1 g = 0 h = 0 I = DateAdd("m", -3, y) J = DateAdd("m", -6, y) K = DateAdd("m", -9, y) L = DateAdd("m", -12, y) For iD = 2 To 65536 Select Case I & J & K & L Case D.Cells(iD, 7).Value >= I ligne = 10 Case I > D.Cells(iD, 7).Value >= J ligne = 9 Case J > D.Cells(iD, 7).Value >= K ligne = 8 Case K > D.Cells(iD, 7).Value >= L ligne = 7 Case D.Cells(iD, 7).Value < L ligne = 6 Case Else ligne = -1 End Select If ligne > -1 Then D.Range(iD & ";" & 13).Copy A.Cells(iA, 1).Value e = A.Cells(iA, 1).Value g = g + e ' // g permet de stocker la somme h = h + 1 ' // compte le nombre d'operations passe entre les dates definies iA = iA + 1 R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results End IF Next
Donc c'est factorisé, j'ai ajouté deux/trois bricoles pour faire joli.
Mais ça ne marche toujours pas.
Ben non ! C'est quoi ce massacre au Select Case ?
Tiens, juste pour le plaisir, affiche ta ligne 23 :
MsgBox I & J & K & L
Voici la bonne syntaxe :
Select Case D.Cells(iD, 7).Value Case Is >= I ligne = 10 Case Is >= J ligne = 9 Case Is >= K ligne = 8 Case Is >= L ligne = 7 Case Is < L ligne = 6 Case Else ligne = -1 End Select
A part qu'on voit tout de suite qu'il faut prendre le problème à l'envers :
Et la clause Case Else disparaît parce qu'on a traité tous les cas.
Select Case D.Cells(iD, 7).Value Case Is < L: ligne = 6 Case Is >= L: ligne = 7 Case Is >= K: ligne = 8 Case Is >= J : ligne = 9 Case Is >= I: ligne = 10 End Select
Ton code devient :
Et la clause Case Else réapparaît
Dim A, D, R As Worksheet Dim g, e, h As Long Dim iD, iA As Long Dim ligne As Long Set A = Worksheets("Age Analysis" ) Set R = Worksheets("Results" ) Set D = Worksheets("Debit" ) iA = 1 g = 0 h = 0 For iD = 2 To 65536 Select Case CDate(D.Cells(iD, 7).Value) Case Is >= DateAdd("m", -12, y): ligne = 7 Case Is >= DateAdd("m", -9, y): ligne = 8 Case Is >= DateAdd("m", -6, y): ligne = 9 Case Is >= DateAdd("m", -3, y): ligne = 10 Case Else: ligne = 6 End Select e = D.Range(iD & ";" & 13).Value A.Cells(iA, 1).Value = e g = g + e ' // g permet de stocker la somme h = h + 1 ' // compte le nombre d'operations passe entre les dates definies iA = iA + 1 R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results Next
EDIT: relire la ligne 23.
bon, alors en fait, le debogeur bloque à la ligne 23 de ton dernier programme:
"erreur 1004 définie par l'application ou par l'objet"
Et j'ai bien compris les conditions pour le select case, je te remercie de m'avoir éclairé ^^
pourtant, la variable est bien déclarée.... serai-ce le Range qui bloque ?
"erreur 1004 définie par l'application ou par l'objet"
Et j'ai bien compris les conditions pour le select case, je te remercie de m'avoir éclairé ^^
pourtant, la variable est bien déclarée.... serai-ce le Range qui bloque ?
merci !!!!
bon, maintenant j'ai voulu remplacer les numeros de colonnes par une variable aui enregistre le resultat d'une imputbox.
le probleme c'est que quand je met la variable a la place du 7 (ligne 15) il me met erreur : 1004, application ou objet non defini !!
j'ai pas de chance avec les erreurs 1004 !!!!
serai-ce parceque Cells() ne peut pas prendre en compte de variables ?
bon, maintenant j'ai voulu remplacer les numeros de colonnes par une variable aui enregistre le resultat d'une imputbox.
le probleme c'est que quand je met la variable a la place du 7 (ligne 15) il me met erreur : 1004, application ou objet non defini !!
j'ai pas de chance avec les erreurs 1004 !!!!
serai-ce parceque Cells() ne peut pas prendre en compte de variables ?
et pourrais-je te demander aussi d'expliquer la modification que tu as faite ligne 23... (pourquoi....., toujours pourquoi ^^)
PS: je poste le code complet .. les erreurs sont ligne 56 et 73...
PS: je poste le code complet .. les erreurs sont ligne 56 et 73...
Dim datevaleur, colmontant, numcolonne As String
Dim y As Date
Dim A, D, R, M, C As Worksheet
Dim g, e, h, iD, iA, iC, iM, ligne, vd, aie As Long
Set A = Worksheets("Age Analysis")
Set R = Worksheets("Results")
Set D = Worksheets("Debit")
Set M = Worksheets("Sheet1")
Set C = Worksheets("Credit")
iA = 1
iC = 2
iD = 2
g = 0
h = 0
e = 0
datevaleur = Application.InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis ")
If IsDate(datevaleur) Then
y = CDate(datevaleur)
MsgBox "You've written the value date :" & y, vbOKCancel
If VB = yes Then
numcolonne = Application.InputBox("Please enter the date column number for the date comparison :", " Column number's reference")
If FormatNumber(numcolonne) Then
vd = numcolonne
MsgBox "You've entered column :" & vd, vbOKCancel
If VB = yes Then
colmontant = Application.InputBox("Please enter the Amount column number :", " Column number ")
If FormatNumber(colmontant) Then
aie = colmontant
MsgBox "You've entered column :" & aie, vbOKCancel
If VB = yes Then
M.Cells.AutoFilter
M.Cells.EntireColumn.AutoFit
For iM = 1 To 65536
If M.Cells.Text = "Credit" Then
M.Range(iM & ":" & iM).Copy C.Cells(iC, 1)
iC = iC + 1
ElseIf M.Cells.Text = "Debit" Then
M.Range(iM & ":" & iM).Copy D.Cells(iD, 1)
iD = iD + 1
End If
Next
M.Rows("1:1").Copy D.Rows("1:1")
M.Rows("1:1").Copy C.Rows("1:1")
C.Columns("G:G").NumberFormat = "d/m/yyyy"
D.Columns("G:G").NumberFormat = "d/m/yyyy"
C.Cells.AutoFilter
C.Cells.EntireColumn.AutoFit
D.Cells.AutoFilter
D.Cells.EntireColumn.AutoFit
For iD = 2 To 65536
Select Case CDate((D.Cells(iD, vd).Value))
Case Is >= DateAdd("m", -12, y): ligne = 7
Case Is >= DateAdd("m", -9, y): ligne = 8
Case Is >= DateAdd("m", -6, y): ligne = 9
Case Is >= DateAdd("m", -3, y): ligne = 10
Case Else: ligne = 6
End Select
e = D.Range(iD & ";" & aie).Value
A.Cells(iA, 1).Value = e
g = g + e ' // g permet de stocker la somme
h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
iA = iA + 1
R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
Next
For iC = 2 To 65536
Select Case CDate((C.Cells(iC, vd).Value))
Case Is >= DateAdd("m", -12, y): ligne = 7
Case Is >= DateAdd("m", -9, y): ligne = 8
Case Is >= DateAdd("m", -6, y): ligne = 9
Case Is >= DateAdd("m", -3, y): ligne = 10
Case Else: ligne = 6
End Select
e = C.Range(iC & ";" & aie).Value
A.Cells(iA, 2).Value = e
g = g + e ' // g permet de stocker la somme
h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
iA = iA + 1
R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
Next
Else: MsgBox "You have interrupted the Age Analysis. ", vbExclamation
End If
Else: MsgBox "You have not written a Number !", vbExclamation
End If
Else: MsgBox "You have interrupted the Age Analysis. ", vbExclamation
End If
Else: MsgBox "You have not written a number !", vbExclamation
End If
Else: MsgBox "You have interrupted the Age Analysis. ", vbExclamation
End If
Else: MsgBox "You have not written a date !", vbExclamation
End If
en fait, ligne 63 aussi !!! donc ce n'est pas un problème de doublons !!!
bon, je re-poste le code....
Merci beaucoup zeb de m'avoir aider jusqu'à présent...
bon, je re-poste le code....
Dim datevaleur, colmontant, numcolonne, vd, aie As String
Dim y As Date
Dim A, D, R, M, C As Worksheet
Dim g, e, h, iD, iA, iC, iM, ligne, ivd, iaie As Long
Set A = Worksheets("Age Analysis")
Set R = Worksheets("Results")
Set D = Worksheets("Debit")
Set M = Worksheets("Sheet1")
Set C = Worksheets("Credit")
iA = 1
iC = 2
iD = 2
g = 0
h = 0
e = 0
datevaleur = Application.InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis ")
If IsDate(datevaleur) Then
y = CDate(datevaleur)
MsgBox "You've written the value date :" & y, vbOKCancel
If VB = yes Then
numcolonne = Application.InputBox("Please enter the date column number for the date comparison :", " Column number's reference")
If FormatNumber(numcolonne) Then
vd = numcolonne
MsgBox "You've entered column :" & vd, vbOKCancel
If VB = yes Then
colmontant = Application.InputBox("Please enter the Amount column number :", " Column number ")
If FormatNumber(colmontant) Then
aie = colmontant
MsgBox "You've entered column :" & aie, vbOKCancel
If VB = yes Then
M.Cells.AutoFilter
M.Cells.EntireColumn.AutoFit
For iM = 1 To 65536
If M.Cells.Text = "Credit" Then
M.Range(iM & ":" & iM).Copy C.Cells(iC, 1)
iC = iC + 1
ElseIf M.Cells.Text = "Debit" Then
M.Range(iM & ":" & iM).Copy D.Cells(iD, 1)
iD = iD + 1
End If
Next
M.Rows("1:1").Copy D.Rows("1:1")
M.Rows("1:1").Copy C.Rows("1:1")
C.Columns("G:G").NumberFormat = "d/m/yyyy"
D.Columns("G:G").NumberFormat = "d/m/yyyy"
C.Cells.AutoFilter
C.Cells.EntireColumn.AutoFit
D.Cells.AutoFilter
D.Cells.EntireColumn.AutoFit
ivd = FormatNumber(vd)
iae = FormatNumber(aie)
For iD = 2 To 65536
Select Case CDate(D.Cells(iD, ivd).Value)
Case Is >= DateAdd("m", -12, y): ligne = 7
Case Is >= DateAdd("m", -9, y): ligne = 8
Case Is >= DateAdd("m", -6, y): ligne = 9
Case Is >= DateAdd("m", -3, y): ligne = 10
Case Else: ligne = 6
End Select
e = D.Range(iD & ";" & iaie).Value
A.Cells(iA, 1).Value = e
g = g + e ' // g permet de stocker la somme
h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
iA = iA + 1
R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
Next
For iC = 2 To 65536
Select Case CDate(C.Cells(iC, ivd).Value)
Case Is >= DateAdd("m", -12, y): ligne = 7
Case Is >= DateAdd("m", -9, y): ligne = 8
Case Is >= DateAdd("m", -6, y): ligne = 9
Case Is >= DateAdd("m", -3, y): ligne = 10
Case Else: ligne = 6
End Select
e = C.Range(iC & ";" & iaie).Value
A.Cells(iA, 2).Value = e
g = g + e ' // g permet de stocker la somme
h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
iA = iA + 1
R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
Next
Else: MsgBox "You have interrupted the Age Analysis. ", vbExclamation
End If
Else: MsgBox "You have not written a Number !", vbExclamation
End If
Else: MsgBox "You have interrupted the Age Analysis. ", vbExclamation
End If
Else: MsgBox "You have not written a number !", vbExclamation
End If
Else: MsgBox "You have interrupted the Age Analysis. ", vbExclamation
End If
Else: MsgBox "You have not written a date !", vbExclamation
End If
Merci beaucoup zeb de m'avoir aider jusqu'à présent...
Salut,
Je ne t'ai pas abandonné, je prenais de vraies vacances : 4 jours sans téléphone, ni internet
Reprenons.
Première ligne, première erreur. VB est un langage très laid, qui incite à faire des erreurs.
Si tu ne précises pas le type d'une variable, VB considère que c'est un Variant. Ta ligne, devient explicitement :
Qu'est-ce que cette variable VB que tu mets partout ?
Sinon, ohlala !! que c'est pénible ces indentations à n'en plus finir. C'est très académique (on dirait du PASCAL) mais ça en devient illisible.
Je te propose une autre méthode de programmation. Elimine tous les cas particuliers, puis traite le cas général.
Exemple :
Si tu comptes te servir du résultat d'une MsgBox, programme-le comme suit :
Pour rappel, il ne faut pas oublier que l'utilisateur peut fermer en cliquant sur la croix, au clavier par [Alt-F4]. Pour ne rien oublier, et parce qu'en général, seule une valeur est intéressante, voici encore une autre façon de faire :
----------------
Ligne 47
C'est pas faux. Mais c'est moche !
Essaie Rows("1") ou mieux Rows(1). Pareil pour les deux lignes suivantes.
Ligne 65
----------------
Bon, sinon il est où ton problème ?
Je ne t'ai pas abandonné, je prenais de vraies vacances : 4 jours sans téléphone, ni internet
Reprenons.
Dim datevaleur, colmontant, numcolonne, vd, aie As String
Première ligne, première erreur. VB est un langage très laid, qui incite à faire des erreurs.
Si tu ne précises pas le type d'une variable, VB considère que c'est un Variant. Ta ligne, devient explicitement :
Je crois que ce n'est pas ce que tu voulais.
Dim datevaleur As Variant, colmontant As Variant, numcolonne As Variant, vd As Variant, aie As String
Les "*Box" sont des fonctions de l'objet Application. Mais tu n'es pas obligé de le préciser. Par contre sois logique. Mets-le partout ou nulle part :
datevaleur = Application.InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis " )
MsgBox "You've written the value date :" & y, vbOKCancel
datevaleur = Application.InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis " )
Application.MsgBox "You've written the value date :" & y, vbOKCancel
datevaleur = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis " )
MsgBox "You've written the value date :" & y, vbOKCancel
Qu'est-ce que cette variable VB que tu mets partout ?
Sinon, ohlala !! que c'est pénible ces indentations à n'en plus finir. C'est très académique (on dirait du PASCAL) mais ça en devient illisible.
Je te propose une autre méthode de programmation. Elimine tous les cas particuliers, puis traite le cas général.
Exemple :
datevaleur = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis " )
If Not IsDate(datevaleur) Then
// ' Cas particulier : la date n'est pas bien saisie.
MsgBox "You have not written a date !"
Exit Sub
End If
// ' On continue
....
Si tu comptes te servir du résultat d'une MsgBox, programme-le comme suit :
Dim code_retour As VBMsgBoxResult
' // Pour ne pas t'embêter, tu peux utiliser un Long
' // vbOkCancelAbortRetryIgnoreYesNo n'existe pas !
code_retour = MsgBox "Message", vbOkCancelAbortRetryIgnoreYesNo
If code_retour = vbOk Then
Else ...
' // Mieux que les If Then Else imbriqués
Select Case MsgBox "Message", vbOkCancelAbortRetryIgnoreYesNo
Case vbOk : ' // C'est Ok
Case vbCancel : ' // Annulé
....
Pour rappel, il ne faut pas oublier que l'utilisateur peut fermer en cliquant sur la croix, au clavier par [Alt-F4]. Pour ne rien oublier, et parce qu'en général, seule une valeur est intéressante, voici encore une autre façon de faire :
If MsgBox "Message", vbYesNo <> vbYes Then
' // Tu veux pas ?
' // Alors on s'en va !
Exit Sub
End If
----------------
Ligne 47
M'ouais
M.Rows("1:1" )
C'est pas faux. Mais c'est moche !Essaie Rows("1") ou mieux Rows(1). Pareil pour les deux lignes suivantes.
Ligne 65
Dis donc, tu sais te servir de Cells() alors ne t'embête pas à reconstruire des adresses pour Range()
e = D.Range(iD & ";" & iaie).Value
----------------
Bon, sinon il est où ton problème ?
le tel a la limite mais 4 jours sans internet !!! je sais pas comment tu fait, moi je me sens mal....
mais c'est vrai que pour le coup ca fait de vrai vacances !!!
bon, par ou je commence !!!!
pendant ces 4 jours j'avais quand meme avance sur le code notamment remplace les range par des cells (et ca marche tout de suite mieux !!) mais pour cela j'ai du insere une variable vb.
en fait, mes colonnes du tableau ont toujours le meme en-tete mais jamais le meme ordr. du coup je n'ai pas trouver de meilleur solution que de dmander a l'utilisateur de donner le numero de la colonne qui m'interesse (stocke dans vb et aie). et comme j'ai besoins de connaitre 5 colonnes du tableau ... d'ou les imputbox a repetition !!
Je pense les eliminees en faisant un userform complet des le debut. maintenant c'est vrai que si excel pouvait se demerder tout seul pour trouver les bonnes colonnes en fonction des en-tetes ca m'arrangerai. je continue de chercher mais je ne trouve pas de solution... du moins, qui marche !!!
et oui... on dirait du pascal !!! c'est vrai que la logique et les fonctions sont tres proches... et comme j'ai ete initie sur du PASCAL...j'ai des restes !!!!!!
je re travaille le code avec ce que tu m'a indique et je le reposte...
je vais y arriver... si si !!
"dsl pour les accents mais c'est pas pratique ces claviers qwerty ..... "
mais c'est vrai que pour le coup ca fait de vrai vacances !!!bon, par ou je commence !!!!
pendant ces 4 jours j'avais quand meme avance sur le code notamment remplace les range par des cells (et ca marche tout de suite mieux !!) mais pour cela j'ai du insere une variable vb.
en fait, mes colonnes du tableau ont toujours le meme en-tete mais jamais le meme ordr. du coup je n'ai pas trouver de meilleur solution que de dmander a l'utilisateur de donner le numero de la colonne qui m'interesse (stocke dans vb et aie). et comme j'ai besoins de connaitre 5 colonnes du tableau ... d'ou les imputbox a repetition !!
Je pense les eliminees en faisant un userform complet des le debut. maintenant c'est vrai que si excel pouvait se demerder tout seul pour trouver les bonnes colonnes en fonction des en-tetes ca m'arrangerai. je continue de chercher mais je ne trouve pas de solution... du moins, qui marche !!!
et oui... on dirait du pascal !!! c'est vrai que la logique et les fonctions sont tres proches... et comme j'ai ete initie sur du PASCAL...j'ai des restes !!!!!!
je re travaille le code avec ce que tu m'a indique et je le reposte...
je vais y arriver... si si !!
"dsl pour les accents mais c'est pas pratique ces claviers qwerty ..... "
ouf...
ah, j'ai aussi oublie de preciser que bien qu'ayant retravailler mon code, jusqu'a present, il n'affiche pas le resultat. enfin si, il affiche les 65536 et des de la boucle for et fait la somme de toute les cases de la colonne indiquee meme si ell contiennent un 0.. ce qui fait que ca rame a mort !!!!
je suis oblige de liberer la memoire a chaque essai !
bref, je commence par simplifier le code, le userform et on vera ce probleme la apres...
que de patience pour un petit programme de rien du tout
ah, j'ai aussi oublie de preciser que bien qu'ayant retravailler mon code, jusqu'a present, il n'affiche pas le resultat. enfin si, il affiche les 65536 et des de la boucle for et fait la somme de toute les cases de la colonne indiquee meme si ell contiennent un 0.. ce qui fait que ca rame a mort !!!!
je suis oblige de liberer la memoire a chaque essai !
bref, je commence par simplifier le code, le userform et on vera ce probleme la apres...
que de patience pour un petit programme de rien du tout
bon, je suis de retour...
j'ai un petit peu travailler sur le code.
le voici:
j'ai un petit peu travailler sur le code.
le voici:
Dim datevaleur As String
Dim colmontant As String
Dim numcolonne As String
Dim debitcred As String
Dim vd As String
Dim aie As String
Dim e As String
Dim y As Date
Dim D As Worksheet
Dim R As Worksheet
Dim M As Worksheet
Dim C As Worksheet
Dim g As Long
Dim h As Long
Dim iD As Long
Dim iC As Long
Dim iM As Long
Dim ligne As Long
Dim ivd As Long
Dim iaie As Long
Dim dc As Long
Set R = Worksheets("Results")
Set D = Worksheets("Debit")
Set M = Worksheets("Sheet1")
Set C = Worksheets("Credit")
iC = 2
iD = 2
g = 0
h = 0
e = 0
datevaleur = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis ")
If Not IsDate(datevaleur) Then ' Cas particulier : la date n'est pas bien saisie.
MsgBox "You have not written a date !"
Exit Sub
End If
numcolonne = InputBox("Please enter the date column number for the date comparison :", " Column number's reference")
If Format(numcolonne) <> Number Then
MsgBox "You have not written a number !"
Exit Sub
End If
colmontant = InputBox("Please enter the Amount column number :", " Column number ")
If Format(colmontant) <> Number Then
MsgBox "You have not written a number !"
Exit Sub
End If
debitcred = InputBox("Please enter the D/C column number :", " Column number ")
If Format(colmontant) <> Number Then
MsgBox "You have not written a number !"
Exit Sub
End If
'UserForm1.Show
MsgBox "You've written the value date :" & y, vbOKCancel
MsgBox "You've entered column :" & vd, vbOKCancel
MsgBox "You've entered column :" & aie, vbOKCancel
MsgBox "You've entered column :" & dc, vbOKCancel
M.Cells.AutoFilter
M.Cells.EntireColumn.AutoFit
For iM = 1 To 65536
If M.Cells(iM, dc).Text = "Credit" Then
M.Range(iM & ":" & iM).Copy C.Cells(iC, 1)
iC = iC + 1
ElseIf M.Cells(iM, dc).Text = "Debit" Then
M.Range(iM & ":" & iM).Copy D.Cells(iD, 1)
iD = iD + 1
End If
Next
M.Rows(1).Copy D.Rows(1)
M.Rows(1).Copy C.Rows(1)
C.Columns("vd:vd").NumberFormat = "d/m/yyyy"
D.Columns("vd:vd").NumberFormat = "d/m/yyyy"
C.Cells.AutoFilter
C.Cells.EntireColumn.AutoFit
D.Cells.AutoFilter
D.Cells.EntireColumn.AutoFit
ivd = FormatNumber(vd)
iaie = FormatNumber(aie)
For iD = 2 To 65536
Select Case CDate(D.Cells(iD, ivd).Value & C.Cells(iC, ivd).Value)
Case Is >= DateAdd("m", -12, y): ligne = 7
Case Is >= DateAdd("m", -9, y): ligne = 8
Case Is >= DateAdd("m", -6, y): ligne = 9
Case Is >= DateAdd("m", -3, y): ligne = 10
Case Else: ligne = 6
End Select
If Cells(iD, iaie).Text <> "" Then
e = D.Cells(iD, iaie).Value
g = g + e ' // g permet de stocker la somme
h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
End If
If Cells(iC, iaie).Text <> "" Then
e = C.Cells(iC, iaie).Value
g = g + e ' // g permet de stocker la somme
h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
End If
Next
R.PrintPreview
C.PrintPreview
D.PrintPreview
M.PrintPreview
Set wordApp = Nothing 'libère la mémoire
maintenant j'ai quelques questions :
1- ligne 41, 46 et 51 je n'arrive pas à lui faire dire que si la valeur rentrée dans l'imputbox n'est pas un chiffre alors... msgbox
2- g ne comptabilise pas la somme des e , serait - ce parce qu'il est employé 2 fois ?
3- h comptabilise le nombre de boucle effectuées et non le nombre d'opérations entre les dates définies
4- je compte mettre un userform à la place de toute les msgbox ligne 57,58,59,60.
comment faire pour que ce dernier affiche les valeurs y, vd, aie ? (j'ai déjà fait sa mise en forme)
voilà...
ais-je bien factorisé ???
PS: c'est mieux avec les accents !!!
1- ligne 41, 46 et 51 je n'arrive pas à lui faire dire que si la valeur rentrée dans l'imputbox n'est pas un chiffre alors... msgbox
2- g ne comptabilise pas la somme des e , serait - ce parce qu'il est employé 2 fois ?
3- h comptabilise le nombre de boucle effectuées et non le nombre d'opérations entre les dates définies
4- je compte mettre un userform à la place de toute les msgbox ligne 57,58,59,60.
comment faire pour que ce dernier affiche les valeurs y, vd, aie ? (j'ai déjà fait sa mise en forme)
voilà...
ais-je bien factorisé ???
PS: c'est mieux avec les accents !!!
1 - Tu as trouvé IsDate() pour les dates, mais tu cherches encore IsNumeric().
2 - Euh, ben oui gros malin ! Je propose gD et gC.
3 - Pas compris la question
4 - Pareil. Pas compris.
Autre chose. Ton code est lent ? Améliore-le.
FormatNumber permet de transformer un nombre en chaîne de caractères selon un certain format. Tu cherches à faire le contraire !
Dis-donc, tu n'aurais pas un peu trop factorisé ?
Il te faut deux blocs Select Case, mais dans une seule boucle.
2 - Euh, ben oui gros malin ! Je propose gD et gC.
3 - Pas compris la question
4 - Pareil. Pas compris.
Autre chose. Ton code est lent ? Améliore-le.
' // Code moche, lent, qui nécessite plein de calculs
M.Range(iM & ":" & iM)....
C.Columns("vd:vd" )....
' // Code efficace
M.Rows(iM)....
C.Columns(ivd)....
M'enfin ?
ivd = FormatNumber(vd)
FormatNumber permet de transformer un nombre en chaîne de caractères selon un certain format. Tu cherches à faire le contraire !
Encore une fois, tu as trouvé CDate() mais pas CLng() !
ivd = CLong(vd)
Ces calculs sont faits 65535*4 fois. C'est beaucoup. Utilise quatre variables et sors ces calculs de la boucle !
DateAdd("m", -12, y)
Tu ne précises pas la feuille dans la première ligne ? Le calcul Cells(iD, iaie).Text/Value est fait deux fois. L'utilisation de la variable e est justement là pour s'économiser ce travail.
If Cells(iD, iaie).Text <> "" Then
e = D.Cells(iD, iaie).Value
g = g + e
e = D.Cells(iD, iaie).Value
If e <> "" Then
g = g + e
Dis-donc, tu n'aurais pas un peu trop factorisé ?
Il te faut deux blocs Select Case, mais dans une seule boucle.
Citation :
DateAdd("m", -12, y)
Ces calculs sont faits 65535*4 fois. C'est beaucoup. Utilise quatre variables et sors ces calculs de la boucle !
j'ai pas trop compris l'histoire des 4 variables alors j'ai mis 2 variables ligne....
oups pour l'exces de factorisation !!!!! (j'aurais essaye !!!
)Par contre je n'ai aucune idee de comment rassembler mes boucles ..
bon je poste le code sans les declarations de variables... ca fera toujours 25 lignes en moins !!!
isnumeric()... ca parait evident !!!!
idem pour Clng() !!!
datevaleur = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis ")
If Not IsDate(datevaleur) Then ' Cas particulier : la date n'est pas bien saisie.
MsgBox "You have not written a date !"
Exit Sub
End If
numcolonne = InputBox("Please enter the date column number for the date comparison :", " Column number's reference")
If Not IsNumeric(numcolonne) Then
MsgBox "You have not written a number !"
Exit Sub
End If
colmontant = InputBox("Please enter the Amount column number :", " Column number ")
If Not IsNumeric(colmontant) Then
MsgBox "You have not written a number !"
Exit Sub
End If
debitcred = InputBox("Please enter the D/C column number :", " Column number ")
If Not IsNumeric(colmontant) Then
MsgBox "You have not written a number !"
Exit Sub
End If
'UserForm1.Show
MsgBox "You've written the value date :" & y, vbOKCancel
MsgBox "You've entered column :" & vd, vbOKCancel
MsgBox "You've entered column :" & aie, vbOKCancel
MsgBox "You've entered column :" & dc, vbOKCancel
M.Cells.AutoFilter
M.Cells.EntireColumn.AutoFit
For iM = 1 To 65536
If M.Cells(iM, dc).Text = "Credit" Then
M.Rows(iM).Copy C.Cells(iC, 1)
iC = iC + 1
ElseIf M.Cells(iM, dc).Text = "Debit" Then
M.Rows(iM).Copy D.Cells(iD, 1)
iD = iD + 1
End If
Next
M.Rows(1).Copy D.Rows(1)
M.Rows(1).Copy C.Rows(1)
C.Columns(ivd).NumberFormat = "d/m/yyyy"
D.Columns(ivd).NumberFormat = "d/m/yyyy"
C.Cells.AutoFilter
C.Cells.EntireColumn.AutoFit
D.Cells.AutoFilter
D.Cells.EntireColumn.AutoFit
ivd = CLng(vd)
iaie = CLng(aie)
Select Case CDate(D.Cells(iD, ivd).Value)
Case Is >= DateAdd("m", -12, y): ligne = 7
Case Is >= DateAdd("m", -9, y): ligne = 8
Case Is >= DateAdd("m", -6, y): ligne = 9
Case Is >= DateAdd("m", -3, y): ligne = 10
Case Else: ligne = 6
End Select
Select Case CDate(C.Cells(iC, ivd).Value)
Case Is >= DateAdd("m", -12, y): lnc = 7
Case Is >= DateAdd("m", -9, y): lnc = 8
Case Is >= DateAdd("m", -6, y): lnc = 9
Case Is >= DateAdd("m", -3, y): lnc = 10
Case Else: lnc = 6
End Select
For iD = 2 To 65536
e = D.Cells(iD, iaie).Value
If e <> "" Then
gD = gD + e ' // g permet de stocker la somme
hD = hD + 1 ' // compte le nombre d'operations passe entre les dates definies
R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
End If
e = C.Cells(iC, iaie).Value
If e <> "" Then
gC = gC + e ' // g permet de stocker la somme
hC = hC + 1 ' // compte le nombre d'operations passe entre les dates definies
R.Cells(lnc, 11).Value = g ' // affiche la somme dans la cellule de la feuille Results
R.Cells(lnc, 10).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
End If
Next
R.PrintPreview
C.PrintPreview
D.PrintPreview
M.PrintPreview
Set wordApp = Nothing 'libère la mémoire
bon alors forcement si j'oublie de modifier la moitie !!!
voila :
(probleme avec le slect case, la copie ne marche que pour le premier case du premier select case.)
voila :
(probleme avec le slect case, la copie ne marche que pour le premier case du premier select case.)
y = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis ")
If Not IsDate(y) Then ' Cas particulier : la date n'est pas bien saisie.
MsgBox "You have not written a date !"
Exit Sub
End If
vd = InputBox("Please enter the date column number for the date comparison :", " Column number's reference")
If Not IsNumeric(vd) Then
MsgBox "You have not written a number !"
Exit Sub
End If
aie = InputBox("Please enter the Amount column number :", " Column number ")
If Not IsNumeric(aie) Then
MsgBox "You have not written a number !"
Exit Sub
End If
dc = InputBox("Please enter the D/C column number :", " Column number ")
If Not IsNumeric(dc) Then
MsgBox "You have not written a number !"
Exit Sub
End If
MsgBox "You've written the value date :" & y, vbOKCancel
MsgBox "You've entered column :" & vd, vbOKCancel
MsgBox "You've entered column :" & aie, vbOKCancel
MsgBox "You've entered column :" & dc, vbOKCancel
M.Cells.AutoFilter
M.Cells.EntireColumn.AutoFit
For iM = 1 To 65536
If M.Cells(iM, dc).Value = "Credit" Then
M.Rows(iM).Copy C.Cells(iC, 1)
iC = iC + 1
ElseIf M.Cells(iM, dc).Value = "Debit" Then
M.Rows(iM).Copy D.Cells(iD, 1)
iD = iD + 1
End If
Next
ivd = CLng(vd)
iaie = CLng(aie)
M.Rows(1).Copy D.Rows(1)
M.Rows(1).Copy C.Rows(1)
C.Columns(ivd).NumberFormat = "d/m/yyyy"
D.Columns(ivd).NumberFormat = "d/m/yyyy"
C.Cells.AutoFilter
C.Cells.EntireColumn.AutoFit
D.Cells.AutoFilter
D.Cells.EntireColumn.AutoFit
Select Case CDate(D.Cells(iD, ivd).Value)
Case Is >= DateAdd("m", -12, y): ligne = 7
Case Is >= DateAdd("m", -9, y): ligne = 8
Case Is >= DateAdd("m", -6, y): ligne = 9
Case Is >= DateAdd("m", -3, y): ligne = 10
Case Else: ligne = 6
End Select
Select Case CDate(C.Cells(iC, ivd).Value)
Case Is >= DateAdd("m", -12, y): lnc = 7
Case Is >= DateAdd("m", -9, y): lnc = 8
Case Is >= DateAdd("m", -6, y): lnc = 9
Case Is >= DateAdd("m", -3, y): lnc = 10
Case Else: lnc = 6
End Select
For iD = 2 To 65536
e = D.Cells(iD, iaie).Value
If e <> "" Then
gD = gD + e ' // g permet de stocker la somme
hD = hD + 1 ' // compte le nombre d'operations passe entre les dates definies
R.Cells(ligne, 6).Value = gD ' // affiche la somme dans la cellule de la feuille Results
R.Cells(ligne, 5).Value = hD ' // affiche le nombre de date dans la cellulle de la feuille results
End If
e = C.Cells(iC, iaie).Value
If e <> "" Then
gC = gC + e ' // g permet de stocker la somme
hC = hC + 1 ' // compte le nombre d'operations passe entre les dates definies
R.Cells(lnc, 11).Value = gC ' // affiche la somme dans la cellule de la feuille Results
R.Cells(lnc, 10).Value = hC ' // affiche le nombre de date dans la cellulle de la feuille results
End If
Next
R.PrintPreview
C.PrintPreview
D.PrintPreview
M.PrintPreview
Set wordApp = Nothing 'libère la mémoire
Pour cela, il faudrait utiliser la balise [fixed]. Mais elle ne marche pas terrible non plus
Je reprends juste les Select et je les mets dans la boucle. Mais je laisse les calculs de Date à l'extérieur.
Bon, ta procédure est trop grosse, elle fait trop de chose, et tout y est mélangé. Donc on va séparer la saisie, les données et la mise en forme.
Pour la saisie et la mise en forme, tu te débrouilles.
Pour les calculs, c'est parti.
Alors, reprenons la copie des données. Etudie cette façon de faire :
Et si on se contentait de cette unique boucle ?
Bon, c'est cool non
Mais moi, j'ai écrit deux fois la même chose. Et ça, ça m'énerve
Je ne veux pas avoir à faire plus d'une fois une même chose. L'ordinateur est fait pour ça, non ?
Alors factorisons
y = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis " ) If Not IsDate(y) Then ' Cas particulier : la date n'est pas bien saisie. MsgBox "You have not written a date !" Exit Sub End If vd = InputBox("Please enter the date column number for the date comparison :", " Column number's reference" ) If Not IsNumeric(vd) Then MsgBox "You have not written a number !" Exit Sub End If aie = InputBox("Please enter the Amount column number :", " Column number " ) If Not IsNumeric(aie) Then MsgBox "You have not written a number !" Exit Sub End If dc = InputBox("Please enter the D/C column number :", " Column number " ) If Not IsNumeric(dc) Then MsgBox "You have not written a number !" Exit Sub End If MsgBox "You've written the value date :" & y, vbOKCancel MsgBox "You've entered column :" & vd, vbOKCancel MsgBox "You've entered column :" & aie, vbOKCancel MsgBox "You've entered column :" & dc, vbOKCancel ' // Tout ça, c'est ok. M.Cells.AutoFilter M.Cells.EntireColumn.AutoFit ' // blabla For iM = 1 To 65536 If M.Cells(iM, dc).Value = "Credit" Then M.Rows(iM).Copy C.Cells(iC, 1) iC = iC + 1 ElseIf M.Cells(iM, dc).Value = "Debit" Then M.Rows(iM).Copy D.Cells(iD, 1) iD = iD + 1 End If Next ' // Cette boucle pourrait être la seule ! ivd = CLng(vd) iaie = CLng(aie) M.Rows(1).Copy D.Rows(1) M.Rows(1).Copy C.Rows(1) ' // Ah, on a pourant commencer à 1 tout à l'heure. C.Columns(ivd).NumberFormat = "d/m/yyyy" D.Columns(ivd).NumberFormat = "d/m/yyyy" C.Cells.AutoFilter C.Cells.EntireColumn.AutoFit D.Cells.AutoFilter D.Cells.EntireColumn.AutoFit ' // blabla Select Case CDate(D.Cells(iD, ivd).Value) Case Is >= DateAdd("m", -12, y): ligne = 7 Case Is >= DateAdd("m", -9, y): ligne = 8 Case Is >= DateAdd("m", -6, y): ligne = 9 Case Is >= DateAdd("m", -3, y): ligne = 10 Case Else: ligne = 6 End Select Select Case CDate(C.Cells(iC, ivd).Value) Case Is >= DateAdd("m", -12, y): lnc = 7 Case Is >= DateAdd("m", -9, y): lnc = 8 Case Is >= DateAdd("m", -6, y): lnc = 9 Case Is >= DateAdd("m", -3, y): lnc = 10 Case Else: lnc = 6 End Select ' // Mais non, bougre d'âne, tu as besoin de iD et iC qui sont la variable qui boucle ! For iD = 2 To 65536 e = D.Cells(iD, iaie).Value If e <> "" Then gD = gD + e ' // g permet de stocker la somme hD = hD + 1 ' // compte le nombre d'operations passe entre les dates definies R.Cells(ligne, 6).Value = gD ' // affiche la somme dans la cellule de la feuille Results R.Cells(ligne, 5).Value = hD ' // affiche le nombre de date dans la cellulle de la feuille results End If e = C.Cells(iC, iaie).Value If e <> "" Then gC = gC + e ' // g permet de stocker la somme hC = hC + 1 ' // compte le nombre d'operations passe entre les dates definies R.Cells(lnc, 11).Value = gC ' // affiche la somme dans la cellule de la feuille Results R.Cells(lnc, 10).Value = hC ' // affiche le nombre de date dans la cellulle de la feuille results End If Next R.PrintPreview C.PrintPreview D.PrintPreview M.PrintPreview ' // Blabla Set wordApp = Nothing 'libère la mémoir ' // Tu m'explique ça ?
Je reprends juste les Select et je les mets dans la boucle. Mais je laisse les calculs de Date à l'extérieur.
Dim y_moins_douze As Date Dim y_moins_neuf As Date Dim y_moins_six As Date Dim y_moins_trois As Date y_moins_douze = DateAdd("m", -12, y) y_moins_neuf = DateAdd("m", -9, y) y_moins_six = DateAdd("m", -6, y) y_moins_trois = DateAdd("m", -3, y) For i = 2 To 65536 Select Case CDate(D.Cells(i, ivd).Value) Case Is >= y_moins_douze: ligne = 7 Case Is >= y_moins_neuf: ligne = 8 Case Is >= y_moins_six: ligne = 9 Case Is >= y_moins_trois: ligne = 10 Case Else: ligne = 6 End Select e = D.Cells(i, iaie).Value If e <> "" Then gD = gD + e hD = hD + 1 R.Cells(ligne, 6).Value = gD R.Cells(ligne, 5).Value = hD End If Select Case CDate(C.Cells(i, ivd).Value) Case Is >= y_moins_douze: ligne = 7 Case Is >= y_moins_neuf: ligne = 8 Case Is >= y_moins_six: ligne = 9 Case Is >= y_moins_trois: ligne = 10 Case Else: ligne = 6 End Select e = C.Cells(i, iaie).Value If e <> "" Then gC = gC + e ' // g permet de stocker la somme hC = hC + 1 ' // compte le nombre d'operations passe entre les dates definies R.Cells(lnc, 11).Value = gC ' // affiche la somme dans la cellule de la feuille Results R.Cells(lnc, 10).Value = hC ' // affiche le nombre de date dans la cellulle de la feuille results End If Next
Bon, ta procédure est trop grosse, elle fait trop de chose, et tout y est mélangé. Donc on va séparer la saisie, les données et la mise en forme.
Pour la saisie et la mise en forme, tu te débrouilles.
Pour les calculs, c'est parti.
Alors, reprenons la copie des données. Etudie cette façon de faire :
Sub DistributionDesDonnées(ws_source As Worksheet, ws_credit As Worksheet, ws_debit As Worksheet, ... ) Dim row_source As Range Dim row_credit As Range Dim row_debit As Range Set row_credit = ws_credit.Rows(1) Set row_debit = ws_debit.Rows(1) For Each row_source In ws_source.Rows Select Case row.Cells(dc).Value Case "Credit" row_source.Copy row_credit Set row_credit = row_credit.Offset(1) Case "Debit" M.Rows(iM).Copy D.Cells(iD, 1) Set row_credit = row_credit.Offset(1) End If Next End Sub
Et si on se contentait de cette unique boucle ?
Sub DistributionDesDonnées(ws_source As Worksheet, _ ws_credit As Worksheet, _ ws_debit As Worksheet, _ ws_result As Worksheet, _ date_ref As Date, _ dc_colnum As Integer, _ date_colnum As Integer, _ amount_colnum As Integer) Dim row_source As Range Dim row_credit As Range Dim row_debit As Range Dim date_(1 To 4) As Date Dim i As Integer Dim i0 As Integer Dim valeur As Long Dim sums_credit(1 To 5) As Long, _ Dim sums_debit(1 To 5) As Long, _ Dim ops_credit(1 To 5) As Long, _ Dim ops_debit(1 To 5) As Long, _ For i = 1 To 4 date_(i) = DateAdd("m", -i * 3, date_ref) Next Set row_credit = ws_credit.Rows(1) Set row_debit = ws_debit.Rows(1) For Each row_source In ws_source.Rows Select Case row.Cells(dc_colnum).Value Case "Credit" row_source.Copy row_credit If IsNumeric(row_credit.Cells(amount_colnum).Value) And _ CLng(row_credit.Cells(amount_colnum).Value) > 0 _ Then i0 = 5 For i = 4 To 1 Step -1 If CDate(row_credit.Cells(date_colnum).Value) >= date_(i) Then i0 = i Exit For End If Next ops_credit(i0) = ops_credit(i0) + 1 sums_credit(i0) = sums_credit(i0) + CLng(row_credit.Cells(amount_colnum).Value) End If Set row_credit = row_credit.Offset(1) Case "Debit" row_source.Copy row_debit If IsNumeric(row_debit.Cells(amount_colnum).Value) And _ CLng(row_debit.Cells(amount_colnum).Value) > 0 _ Then i0 = 5 For i = 4 To 1 Step -1 If CDate(row_debit.Cells(date_colnum).Value) >= date_(month) Then i0 = i Exit For End If Next ops_debit(i0) = ops_debit(i0) + 1 sums_debit(i0) = sums(i0) + CLng(row_debit.Cells(amount_colnum).Value) End If Set row_debit = row_debit.Offset(1) End Select Next For i = 1 To 5 ws_result.Cells(i, ?).Value = sums_credit(i) ws_result.Cells(i, ?).Value = sums_debit(i) ws_result.Cells(i, ?).Value = ops_credit(i) ws_result.Cells(i, ?).Value = ops_debit(i) Next0 End Sub
Bon, c'est cool non
Mais moi, j'ai écrit deux fois la même chose. Et ça, ça m'énerve
Je ne veux pas avoir à faire plus d'une fois une même chose. L'ordinateur est fait pour ça, non ?
Alors factorisons
Enum dc_enum Debit Credit End Enum Sub DistributionDesDonnées(ws_source As Worksheet, _ ws_credit As Worksheet, _ ws_debit As Worksheet, _ ws_result As Worksheet, _ date_ref As Date, _ dc_colnum As Integer, _ date_colnum As Integer, _ amount_colnum As Integer) Dim dc_type As dc_enum Dim row_source As Range Dim row_target(Debit To Credit) As Range Dim date_(1 To 4) As Date Dim i As Integer Dim i0 As Integer Dim valeur As Long Dim sums(Debit To Credit, 1 To 5) As Long, _ Dim opes(Debit To Credit, 1 To 5) As Long, _ For i = 1 To 4 date_(i) = DateAdd("m", -i * 3, date_ref) Next Set row_target(Credit) = ws_credit.Rows(1) Set row_target(Debit) = ws_debit.Rows(1) For Each row_source In ws_source.Rows Select Case row.Cells(dc_colnum).Value Case "Credit" : dc_type = Credit Case "Debit" : dc_type = Debit End Select row_source.Copy row_target(dc_type) If IsNumeric(row_target(dc_type).Cells(amount_colnum).Value) And _ CLng(row_target(dc_type).Cells(amount_colnum).Value) > 0 _ Then i0 = 5 For i = 4 To 1 Step -1 If CDate(row_target(dc_type).Cells(date_colnum).Value) >= date_(i) Then i0 = i Exit For End If Next opes(dc_type, i0) = opes(dc_type, i0) + 1 sums(dc_type, i0) = sums(dc_type, i0) + CLng(row_target(dc_type).Cells(amount_colnum).Value) End If Set row_target(dc_type) = row_target(dc_type).Offset(1) Next For dc_type = Debit To Credit For i = 1 To 5 ws_result.Cells(i, ?).Value = sums(dc_type, i) ws_result.Cells(i, ?).Value = opes(dc_type, i) Next Next End Sub
mouai, ca se complique ....
mdr.. bon, je vais avoir des choses a modifier et a comprendre ....
ferais ca tranquilou ce soir !!!
pour le truc bizarre a la fin il parait que ca libere la memoire .... selon les dires de certaines personnes presente sur un autre forum... ou on ne m'a jamais rep d'ailleurs !!!!
ca veux tout dire je pense ...
Merci, mille fois merci pour tout zeb !!!!!
je dois mechament monopoliser ton temps !
mdr.. bon, je vais avoir des choses a modifier et a comprendre ....
ferais ca tranquilou ce soir !!!
pour le truc bizarre a la fin il parait que ca libere la memoire .... selon les dires de certaines personnes presente sur un autre forum... ou on ne m'a jamais rep d'ailleurs !!!!
ca veux tout dire je pense ...
Merci, mille fois merci pour tout zeb !!!!!
je dois mechament monopoliser ton temps !
bonjour !!!
bon alors j'ai assimile et compris presque tout ce que tu m'a montre... presque....
(le num de ligne correspond a ton dernier code)
1- ln 38-39 la boucle IF bloque sur le isnumeric(.value). j'ai essaye de moifier la chose mais veut pas...
2- ensuite: ln 42 je ne comprend pas ce que fait la boucle for qui remonte a l'envers....
3- ln 43: je pense qu'il n'y a pas de () autour de month ... etje comprend pas d'ou sors le date_month...
4- ln 56-57 je ne comprend pas le fonctionnement de la copie...
pourquoi une boucle for pour les lgnes.. c'est pratique mais si je veux inserer les resultats dans un tableau ca va etre dur .... (lignes de 6 a 10 !!!)
ensuite, les colonnes sont pas les memes pour debit et credit .... pr debit c'est colonne 6 pr sums et 5 pour ops, credit: respectivement 11 et 10
dc soit je recopie les cases dans le tableau par un simple '= nomcase mais c'est moche.. ou il faut que j'insere 2 variables, une ligne et une colonne.....
enfin je crois
bon alors j'ai assimile et compris presque tout ce que tu m'a montre... presque....
(le num de ligne correspond a ton dernier code)
1- ln 38-39 la boucle IF bloque sur le isnumeric(.value). j'ai essaye de moifier la chose mais veut pas...
If IsNumeric(row_target(dc_type).Cells(amount_colnum).Value) And _
CLng(row_target(dc_type).Cells(amount_colnum).Value) > 0 _
Then
2- ensuite: ln 42 je ne comprend pas ce que fait la boucle for qui remonte a l'envers....
3- ln 43: je pense qu'il n'y a pas de () autour de month ... etje comprend pas d'ou sors le date_month...
4- ln 56-57 je ne comprend pas le fonctionnement de la copie...
For i = 1 To 5
ws_result.Cells(i, 6).Value = sums(dc_type, i)
ws_result.Cells(i, 5).Value = ops(dc_type, i)
Next
pourquoi une boucle for pour les lgnes.. c'est pratique mais si je veux inserer les resultats dans un tableau ca va etre dur .... (lignes de 6 a 10 !!!)
ensuite, les colonnes sont pas les memes pour debit et credit .... pr debit c'est colonne 6 pr sums et 5 pour ops, credit: respectivement 11 et 10
dc soit je recopie les cases dans le tableau par un simple '= nomcase mais c'est moche.. ou il faut que j'insere 2 variables, une ligne et une colonne.....
enfin je crois
1 -
J'ai corrigé mon code. 'scuse-moi...
Bien vu de ta part
2 - Eh, eh !!
C'est ça la programmation !
Tu aimes les maths ?
Voici deux algos :
Pour x = 10, qu'affiche le premier ? Le second ?
Maintenant, regarde pourquoi j'ai pris la boucle à l'envers.
3 -
J'ai corrigé mon code. 'scuse-moi...
Mal vu de ta part
4 - Arf. C'est pour ça que j'ai laissé des ?
Trop fort, non ?
Pour libérer la mémoire allouée à la variable wordApp, il faut soit attendre la fin de la fonction, soit lui affecter la valeur Nothing. Dans notre cas, on attendra la fin de la fonction. D'autant qu'il ne me semble pas que tu ais déclaré ni alloué une variable wordApp
J'ai corrigé mon code. 'scuse-moi...
Bien vu de ta part
2 - Eh, eh !!
C'est ça la programmation !Tu aimes les maths ?
x < -12 => x <-3
Voici deux algos :
Si X < -3 Alors Affiche -3
Sinon Si X < -6 Alors Affiche -6
Sinon Si X < -9 Alors Affiche -9
Sinon Si X < -12 Alors Affiche -12
Sinon Si X < -6 Alors Affiche -6
Sinon Si X < -9 Alors Affiche -9
Sinon Si X < -12 Alors Affiche -12
Si X < -12 Alors Affiche -12
Sinon Si X < -9 Alors Affiche -9
Sinon Si X < -6 Alors Affiche -6
Sinon Si X < -3 Alors Affiche -3
Sinon Si X < -9 Alors Affiche -9
Sinon Si X < -6 Alors Affiche -6
Sinon Si X < -3 Alors Affiche -3
Pour x = 10, qu'affiche le premier ? Le second ?
Maintenant, regarde pourquoi j'ai pris la boucle à l'envers.
3 -
J'ai corrigé mon code. 'scuse-moi...
Mal vu de ta part
4 - Arf. C'est pour ça que j'ai laissé des ?
For dc_type = Debit To Credit
For i = 1 To 5
ws_result.Cells(i, Iff(dc_type = Debit, 6, 11)).Value = sums(dc_type, i)
...
Next
Next
Trop fort, non ?
Set wordApp = Nothing 'libère la mémoire
Pour libérer la mémoire allouée à la variable wordApp, il faut soit attendre la fin de la fonction, soit lui affecter la valeur Nothing. Dans notre cas, on attendra la fin de la fonction. D'autant qu'il ne me semble pas que tu ais déclaré ni alloué une variable wordApp
ouaip, j'ai rien contre les maths....
mais je trouve pas ce qu'il affiche pour le premier... rien ? et pour le deuxieme rien non plus....
(par contre si c'est x = -10)
.... je penche pour :-3 pour le premier et -12 pour le deuxieme....
YOUHOU, j'ai pige !!!!!
(la boucle if marche tjrs pas chez moi il met erreur 13 : type mismatch... (idem avec .text) j'ai mis un range a la place du cells..mais est ce que ca voudra dire quelquechose range(amount_colnum))
autre chose... c'est quoi ca ? : iff
Ca ressemble a une fonction SI selon la syntaxe mais qd je met IF... il veux pas ? (il me demande un then ....serai-ce un probleme de declaration de variables ?
merci, merci, merci, mille fois merci ......
mais je trouve pas ce qu'il affiche pour le premier... rien ? et pour le deuxieme rien non plus....
(par contre si c'est x = -10)
.... je penche pour :-3 pour le premier et -12 pour le deuxieme....YOUHOU, j'ai pige !!!!!
(la boucle if marche tjrs pas chez moi il met erreur 13 : type mismatch... (idem avec .text) j'ai mis un range a la place du cells..mais est ce que ca voudra dire quelquechose range(amount_colnum))
autre chose... c'est quoi ca ? : iff
Citation :
ws_result.Cells(i, Iff(dc_type = Debit, 6, 11)).Value = sums(dc_type, i)
Ca ressemble a une fonction SI selon la syntaxe mais qd je met IF... il veux pas ? (il me demande un then ....serai-ce un probleme de declaration de variables ?
merci, merci, merci, mille fois merci ......
Citation :
ouaip, j'ai rien contre les maths....mais je trouve pas ce qu'il affiche pour le premier... rien ? et pour le deuxieme rien non plus....
(par contre si c'est x = -10)
.... je penche pour :-3 pour le premier et -12 pour le deuxieme....YOUHOU, j'ai pige !!!!!
Citation :
(la boucle if marche tjrs pas chez moi il met erreur 13 : type mismatch... (idem avec .text) j'ai mis un range a la place du cells..mais est ce que ca voudra dire quelquechose range(amount_colnum))
Citation :
autre chose... c'est quoi ca ? : iff Bon, je reviens sur ton problème de mismatch.
Voici le prototype de notre fonction :
Tu as compris à quoi servait chaque paramètre ? Tu mets quoi comme valeur dans chacun ?
Sub DistributionDesDonnées(ws_source As Worksheet, _ ws_credit As Worksheet, _ ws_debit As Worksheet, _ ws_result As Worksheet, _ date_ref As Date, _ dc_colnum As Integer, _ date_colnum As Integer, _ amount_colnum As Integer)
Sinon, j'ai relu mon code, il manque un ptit truc, au niveau du Select Case de la ligne 32. On teste si on a crédit ou débit. Arf. Et si par hasard, on a autre chose ? Il faut ne pas continuer !
re.. bon we ?
dsl de t'avoir froisse..
oui, j'ai compris l'histoire du range cells... des variables et tout ca... et je ne me sert pas du forum sans avoir chercher de reponse seul prealablement via l'aide excel.!!!
et iff n'existe pas dans l'aide d'excel..... d'ou ma question...
j'ai trouve la reponse maintenant...(IIf)
bref passons,
merci pour l'info sur le case else... mais par contre je n'ai pas encore trouve comment on lui dit de passer a la ligne suivante... mais je vais trouve !!!
dsl de t'avoir froisse..
oui, j'ai compris l'histoire du range cells... des variables et tout ca... et je ne me sert pas du forum sans avoir chercher de reponse seul prealablement via l'aide excel.!!!
et iff n'existe pas dans l'aide d'excel..... d'ou ma question...
j'ai trouve la reponse maintenant...(IIf)
bref passons,
merci pour l'info sur le case else... mais par contre je n'ai pas encore trouve comment on lui dit de passer a la ligne suivante... mais je vais trouve !!!
et bien le probleme c'est que si dans le la premiere feuille, il y a autre chose que D ou C et ben il faudrait qu'il aille a la ligne du dessous....
donc je rajoute un case else :
row_source +1... ou qqch comme ca... mais il faut qu'il revienne en arriere pour recommencer la boucle for
ou je met une boucle IF en plus...j'essaye ca !!
et j'ai beau comprendre les specificites des differentes variables et leur emploi (integer, date, string,worksheet,long...) et ben je n'arrive pas a resoudre mon probleme de mismatch
donc je rajoute un case else :
row_source +1... ou qqch comme ca... mais il faut qu'il revienne en arriere pour recommencer la boucle for
ou je met une boucle IF en plus...j'essaye ca !!
et j'ai beau comprendre les specificites des differentes variables et leur emploi (integer, date, string,worksheet,long...) et ben je n'arrive pas a resoudre mon probleme de mismatch
Ah oui, évidement.
Euh, ... t'aurais pu trouver tout seul, non ?
Dim is_credit_debit As Boolean
...
For Each row_source In ws_source.Rows
is_credit_debit = True
Select Case row.Cells(dc_colnum).Value
Case "Credit" : dc_type = Credit
Case "Debit" : dc_type = Debit
Case Else : is_credit_debit = False
End Select
If Is_credit_debit Then
...
Enf If
Next
Euh, ... t'aurais pu trouver tout seul, non ?
pas aussi vite en tout cas !!!
j'avais commencer a ajouter une autre variable a dc_type (autre)
et mis un if apres mon select case ...
mais je bloquai sur la derniere boucle .... complique avec les if..
(j'avais completement oublier cette methode avec les bouleens ... tu viens de me rememorer un truc bien pratique !!!!! MERCI )
j'avais commencer a ajouter une autre variable a dc_type (autre)
et mis un if apres mon select case ...
mais je bloquai sur la derniere boucle .... complique avec les if..
(j'avais completement oublier cette methode avec les bouleens ... tu viens de me rememorer un truc bien pratique !!!!! MERCI )
bon, je reviens desespere sur ce forum....
j'ai relu plusieurs fois tout les posts... chercher ds l'aide VBA, utiliser le debogeur..(enfin essaye) et je ne comprend toujours pas pourquoi le code ne copie pas les lignes qu'ils devraient.
le calcul des sommes semble fonctionner... mais comme rien n'est resent sur ws_credit et ws_debit... forcement...
un petit coup de pouce ?, une indication ?
j'ai relu plusieurs fois tout les posts... chercher ds l'aide VBA, utiliser le debogeur..(enfin essaye) et je ne comprend toujours pas pourquoi le code ne copie pas les lignes qu'ils devraient.
le calcul des sommes semble fonctionner... mais comme rien n'est resent sur ws_credit et ws_debit... forcement...
un petit coup de pouce ?, une indication ?
For i = 1 To 4
date_(i) = DateAdd("m", -i * 3, date_ref)
Next
Set row_target(Credit) = ws_credit.Rows(1)
Set row_target(Debit) = ws_debit.Rows(1)
For Each row_source In ws_source.Rows
is_credit_debit = True
Select Case Rows.Cells(dc_colnum).Value
Case "Credit": dc_type = Credit
Case "Debit": dc_type = Debit
Case Else: is_credit_debit = False
End Select
If is_credit_debit Then
row_source.Copy row_target(dc_type)
If IsNumeric(row_target(dc_type).Cells(amount_colnum).Value) And CLng(row_target(dc_type).Cells(amount_colnum).Value) > 0 Then
i0 = 5
For i = 4 To 1 Step -1
If CDate(row_target(dc_type).Cells(date_colnum).Value) >= date_(i) Then
i0 = i
End If
Next
ops(dc_type, i0) = ops(dc_type, i0) + 1
sums(dc_type, i0) = sums(dc_type, i0) + CLng(row_target(dc_type).Cells(amount_colnum).Value)
End If
Set row_target(dc_type) = row_target(dc_type).Offset(1)
End If
Next
For dc_type = Debit To Credit
For i = 1 To 5
ws_result.Cells(i, IIf(dc_type = Debit, 6, 11)).Value = sums(dc_type, i)
ws_result.Cells(i, IIf(dc_type = Debit, 5, 10)).Value = ops(dc_type, i)
Next
Next
Alors ?
Dim c_count As Long
Dim d_count As Long
Dim o_count As Long
c_count = 0
d_count = 0
o_count = 0
[...]
For Each row_source In ws_source.Rows
is_credit_debit = True
Select Case Rows.Cells(dc_colnum).Value
Case "Credit": dc_type = Credit: c_count = c_count + 1
Case "Debit": dc_type = Debit: d_count = d_count + 1
Case Else: is_credit_debit = False: o_count = o_count + 1
End Select
[...]
Next
MsgBox "Credit: " & c_count & vbCR & _
"Débit: " & b_count & vbCR & _
"Autres: " & o_count,,"Trouvés"
merci beaucoup zeb pour ton aide.
code final :
code final :
Dim ws_source As Worksheet
Dim ws_credit As Worksheet
Dim ws_debit As Worksheet
Dim ws_result As Worksheet
Dim date_ref As Date
Dim dc_colnum As Integer
Dim date_colnum As Integer
Dim amount_colnum As Integer
Dim is_credit_debit As Boolean
Dim dc_type As dc_enum
Dim row_source As Range
Dim row_target(Debit To Credit) As Range
Dim date_(1 To 4) As Date
Dim i As Integer
Dim i0 As Integer
Dim valeur As Long
Dim sums(Debit To Credit, 1 To 5) As Long
Dim ops(Debit To Credit, 1 To 5) As Long
Dim c_count As Long
Dim d_count As Long
Dim o_count As Long
Set ws_source = Worksheets("Sheet1")
Set ws_credit = Worksheets("Credit")
Set ws_debit = Worksheets("Debit")
Set ws_result = Worksheets("Result")
c_count = 0
d_count = 0
ws_source.Select
ws_source.Rows(1).Copy ws_debit.Rows(1)
ws_source.Rows(1).Copy ws_credit.Rows(1)
date_ref = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis ")
If Not IsDate(date_ref) Then
MsgBox "You have not written a date !"
Exit Sub
End If
date_colnum = InputBox("Please enter the date column number for the date comparison :", " Column number's reference")
If Not IsNumeric(date_colnum) Then
MsgBox "You have not written a number !"
Exit Sub
End If
amount_colnum = InputBox("Please enter the Amount column number :", " Column number ")
If Not IsNumeric(amount_colnum) Then
MsgBox "You have not written a number !"
Exit Sub
End If
dc_colnum = InputBox("Please enter the D/C column number :", " Column number ")
If Not IsNumeric(dc_colnum) Then
MsgBox "You have not written a number !"
Exit Sub
End If
MsgBox "You've entered the value date :" & date_ref & vbCr & _
"You've entered Date column :" & date_colnum & vbCr & _
"You've entered Amount column :" & amount_colnum & vbCr & _
"You've entered D/C column :" & dc_colnum, vbOKCancel
ws_source.Cells.AutoFilter
ws_source.Cells.EntireColumn.AutoFit
For i = 1 To 4
date_(i) = DateAdd("m", -i * 3, date_ref)
Next
Set row_target(Credit) = ws_credit.Rows(2)
Set row_target(Debit) = ws_debit.Rows(2)
For Each row_source In ws_source.Rows
is_credit_debit = True
Select Case row_source.Cells(dc_colnum).Value
Case "Credit": dc_type = Credit: c_count = c_count + 1
Case "credit": dc_type = Credit: c_count = c_count + 1
Case "C": dc_type = Credit: c_count = c_count + 1
Case "c": dc_type = Credit: c_count = c_count + 1
Case "Debit": dc_type = Debit: d_count = d_count + 1
Case "debit": dc_type = Debit: d_count = d_count + 1
Case "D": dc_type = Debit: d_count = d_count + 1
Case "d": dc_type = Debit: d_count = d_count + 1
Case Else: is_credit_debit = False
End Select
If is_credit_debit Then
row_source.Copy row_target(dc_type)
If IsNumeric(row_target(dc_type).Cells(amount_colnum).Value) And CLng(row_target(dc_type).Cells(amount_colnum).Value) > 0 Then
i0 = 5
For i = 4 To 1 Step -1
If CDate(row_target(dc_type).Cells(date_colnum).Value) >= date_(i) Then
i0 = i
End If
Next
ops(dc_type, i0) = ops(dc_type, i0) + 1
sums(dc_type, i0) = sums(dc_type, i0) + CLng(row_target(dc_type).Cells(amount_colnum).Value)
End If
Set row_target(dc_type) = row_target(dc_type).Offset(1)
End If
Next
MsgBox "Credit: " & c_count & vbCr & _
"Debit: " & d_count & vbCr & _
"Total : " & c_count + d_count, , "Trouvés"
For dc_type = Debit To Credit
For i = 1 To 5
ws_result.Cells(i, IIf(dc_type = Debit, 6, 12)).Value = sums(dc_type, i)
ws_result.Cells(i, IIf(dc_type = Debit, 5, 11)).Value = ops(dc_type, i)
Next
Next
ws_credit.Columns(date_colnum).NumberFormat = "d/m/yyyy"
ws_debit.Columns(date_colnum).NumberFormat = "d/m/yyyy"
ws_credit.Cells.AutoFilter
ws_credit.Cells.EntireColumn.AutoFit
ws_debit.Cells.AutoFilter
ws_debit.Cells.EntireColumn.AutoFit
ws_result.Cells(19, 8).Value = date_ref
demand = MsgBox("Go to the print preview ?", vbOKCancel)
If vbOK = True Then
ws_result.PrintPreview
ws_credit.PrintPreview
ws_debit.PrintPreview
ws_source.PrintPreview
End If
Bon, j'ai tout relu, et j'ai deux trois bricoles pour toi.
demand = MsgBox("Go to the print preview ?", vbOKCancel) If vbOK = True Then
Non, non et non. Si tu veux considérer plusieurs cas, énumère-les sur la même ligne :
Select Case row_source.Cells(dc_colnum).Value Case "Credit": dc_type = Credit: c_count = c_count + 1 Case "credit": dc_type = Credit: c_count = c_count + 1 Case "C": dc_type = Credit: c_count = c_count + 1 Case "c": dc_type = Credit: c_count = c_count + 1
Select Case row_source.Cells(dc_colnum).Value Case "Credit", "credit", "C", "c": dc_type = Credit: c_count = c_count + 1
Ensuite, si tu veux t'affranchir des majuscules/minuscules, passe ta variable de test et tes constantes dans une ou l'autre casse :
Select Case LCase(row_source.Cells(dc_colnum).Value) Case "credit", "c": dc_type = Credit: c_count = c_count + 1
Si tu ne veux que la majuscule, par exemple, Credit, credit maps pas CREDIT ni cREDIT, fais-toi la fonction Capitalise() :
Function Capitalise(ByVal s As String) As String Capitalise = UCase(Left(s, 1)) + LCase(Mid(s, 2)) End Function [..] Select Case Capitalise(row_source.Cells(dc_colnum).Value) Case "Credit", "C": dc_type = Credit: c_count = c_count + 1
Un bon truc, c'est aussi de virer les accents. Ils sont souvent oubliés - C'est mal
- ou omis quant on écrit en capitales. Bref, c'est pénible de se planter pour un malheureux accent. J'ai un exemple de fonction ici : http://www.presence-pc.com/forum/ppc/Programmation/macr...Ah, et les espaces, aussi :sarcastique: Devant, derrière, double, etc.
Voici deux ptites fonctions pour "normaliser" une chaîne de caractères :
Function IsSpace(ByVal s As String) As Boolean IsSpace = Left(s, 1) = " " Or _ Left(s, 1) = vbTab Or _ Left(s, 1) = vbCr Or _ Left(s, 1) = vbLf End Function Function Normalise(ByVal s As String) As String Const lettres_d = "åäãâáàÅÄÃÂÁÀëêéèËÊÉÈïîíìÏÎÍÌöõôóòÖÕÔÓÒüûúùÜÛÚÙÿýŸÝñçÑÇ" Const lettres_0 = "aaaaaaAAAAAAeeeeEEEEiiiiIIIIoooooOOOOOuuuuUUUUyyYYncNC" Dim i As Integer Dim p As Integer Dim s0 As String Dim c As String Dim c_prev As String s0 = "" s = Trim(s) c_prev = " " For i = 1 To Len(s) c = Mid(s, i, 1) If IsSpace(c) Then c = "" If Not IsSpace(c_prev) Then c = " " Else p = InStr(lettres_d, c) If p > 0 Then c = Mid(lettres_0, p, 1) End If c_prev = c s0 = s0 + c Next Normalise = s0 End Function
Lassé par la pub ? Créez un compte
- Contenus similaires :
- ForumAide macro vba
- ForumAide vba selection une colonne entiere sous condition bug
- ForumAide sur projet vba excel
- ForumAide programmation vba dans excel
- ForumVba
- ForumAide code vba calcul moyenne mobile
- ForumAide svp vba amp manipulation ldap
- ForumVba deplacement
- ForumFiger vba
- ForumParametres vba
- Voir plus
)![[:_tom_:2] [:_tom_:2]](http://m.bestofmedia.com/sfp/design/usr/fr/smilies/38/0e/_tom_:2.gif)