Se connecter avec
S'enregistrer | Connectez-vous

Aide VBA

Dernière réponse : dans Programmation
Expert 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 ^^)


  1. Dim A, D, R As Worksheet
  2. Dim I, J, K, L As Date
  3. Dim g, e, h As Long
  4. Dim iD, iA As Long
  5.  
  6.  
  7. Set A = Worksheets("Age Analysis")
  8. Set R = Worksheets("Results")
  9.  
  10. iA = 1
  11. g = 0
  12. h = 0
  13.  
  14.  
  15. I = DateAdd("m", -3, y)
  16. J = DateAdd("m", -6, y)
  17. K = DateAdd("m", -9, y)
  18. L = DateAdd("m", -12, y)
  19.  
  20. Select Case I & J & K & L
  21. Case ActiveSheet.Cells(iD, 7).Value >= I
  22. Cells(iD, 13).Value.Select
  23. Selection.Copy
  24. A.Cells(iA, 1).Paste
  25. A.Cells(iA, 1).Value = e
  26. g = g e 'g permet de stocker la somme
  27. h = h 1 'compte le nombre d'operations passe entre les dates definies
  28. iA = iA 1
  29. R.Cells(10, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
  30. R.Cells(10, 5).Value = h 'affiche le nombre d'opérations dans la cellulle de la feuille results
  31.  
  32. Case I > ActiveSheet.Cells(iD, 7).Value >= J
  33. Cells(iD, 13).Value.Select
  34. Selection.Copy
  35. A.Cells(iA, 1).Paste
  36. A.Cells(iA, 1).Value = e
  37. g = g e 'g permet de stocker la somme
  38. h = h 1 'compte le nombre d'operations passe entre les dates definies
  39. iA = iA 1
  40. R.Cells(9, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
  41. R.Cells(9, 5).Value = h 'affiche le nombre d'opérations dans la cellulle de la feuille results
  42.  
  43. etc....
  44.  
  45. End Select
  46.  
  47.  
  48. Next

Autres pages sur : aide vba

Lassé par la pub ? Créez un compte

Meilleure solution

Expert Programmation

Bon, ben faut regarder la ligne juste au dessus:
  1. For Each row_source In ws_source.Rows
  2. [..]
  3. ' // Select Case Rows.Cells(dc_colnum).Value
  4. Select Case row_source.Cells(dc_colnum).Value
Aïe, aïe, aïe !!!
J'ai fait une petite coquille dans mon premier code, tu l'as corrigée, mais mal :pfff: 
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 [:spamafote]
Expert Programmation

Salut,

Ton code est plus qu'inutile, il est faux !
Reposte-le nous, sans les html-entities et avec les caractères qui semblent manquer aux lignes 26, 27, 28, etc.

Il semble y avoir à la fois de très bonnes choses là-dedans, et de très mauvaises.
:o 
Expert Programmation

salut zeb,

Citation :
Il semble y avoir à la fois de très bonnes choses là-dedans, et de très mauvaises.
, 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:

  1. Dim A, D, R As Worksheet
  2. Dim I, J, K, L As Date
  3. Dim g, e, h As Long
  4. Dim iD, iA As Long
  5.  
  6.  
  7. Set A = Worksheets("Age Analysis")
  8. Set R = Worksheets("Results")
  9.  
  10. iA = 1
  11. g = 0
  12. h = 0
  13.  
  14.  
  15. I = DateAdd("m", -3, y)
  16. J = DateAdd("m", -6, y)
  17. K = DateAdd("m", -9, y)
  18. L = DateAdd("m", -12, y)
  19.  
  20.  
  21. Sheets("Debit").Select
  22. For iD = 2 To 65536
  23. Select Case I & J & K & L
  24. Case ActiveSheet.Cells(iD, 7).Value >= I
  25. ActiveSheet.Range(iD & ";" & 13).Copy A.Cells(iA, 1)
  26. e = A.Cells(iA, 1)
  27. g = g + e 'g permet de stocker la somme
  28. h = h + 1 'compte le nombre d'operations passe entre les dates definies
  29. iA = iA + 1
  30. R.Cells(10, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
  31. R.Cells(10, 5).Value = h 'affiche le nombre de date dans la cellulle de la feuille results
  32.  
  33. Case I > ActiveSheet.Cells(iD, 7).Value >= J
  34. ActiveSheet.Range(iD & ";" & 13).Copy A.Cells(iA, 1)
  35. e = A.Cells(iA, 1)
  36. g = g + e 'g permet de stocker la somme
  37. h = h + 1 'compte le nombre d'operations passe entre les dates definies
  38. iA = iA + 1
  39. R.Cells(9, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
  40. R.Cells(9, 5).Value = h 'affiche le nombre de date dans la cellulle de la feuille results
  41.  
  42. Case J > ActiveSheet.Cells(iD, 7).Value >= K
  43. ActiveSheet.Range(iD & ";" & 13).Copy A.Cells(iA, 1)
  44. e = A.Cells(iA, 1)
  45. g = g + e 'g permet de stocker la somme
  46. h = h + 1 'compte le nombre d'operations passe entre les dates definies
  47. iA = iA + 1
  48. R.Cells(8, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
  49. R.Cells(8, 5).Value = h 'affiche le nombre de date dans la cellulle de la feuille results
  50.  
  51. Case K > ActiveSheet.Cells(iD, 7).Value >= L
  52. ActiveSheet.Range(iD & ";" & 13).Copy A.Cells(iA, 1)
  53. e = A.Cells(iA, 1)
  54. g = g + e 'g permet de stocker la somme
  55. h = h + 1 'compte le nombre d'operations passe entre les dates definies
  56. iA = iA + 1
  57. R.Cells(7, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
  58. R.Cells(7, 5).Value = h 'affiche le nombre de date dans la cellulle de la feuille results
  59.  
  60. Case ActiveSheet.Cells(iD, 7).Value < L
  61. ActiveSheet.Range(iD & ";" & 13).Copy A.Cells(iA, 1)
  62. e = A.Cells(iA, 1)
  63. g = g + e 'g permet de stocker la somme
  64. h = h + 1 'compte le nombre d'operations passe entre les dates definies
  65. iA = iA + 1
  66. R.Cells(6, 6).Value = g 'affiche la somme dans la cellule de la feuille Results
  67. R.Cells(6, 5).Value = h 'affiche le nombre de date dans la cellulle de la feuille results
  68.  
  69. End Select
  70.  
  71.  
  72. Next



voilà, je pense que cette fois ci le code s'est affiché correctement.
Expert Programmation

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 :
  1. Dim A, D, R As Worksheet
  2. Dim I, J, K, L As Date
  3. Dim g, e, h As Long
  4. Dim iD, iA As Long
  5.  
  6. Dim ligne As Long
  7.  
  8. Set A = Worksheets("Age Analysis" )
  9. Set R = Worksheets("Results" )
  10. Set D = Worksheets("Debit" )
  11.  
  12. iA = 1
  13. g = 0
  14. h = 0
  15.  
  16. I = DateAdd("m", -3, y)
  17. J = DateAdd("m", -6, y)
  18. K = DateAdd("m", -9, y)
  19. L = DateAdd("m", -12, y)
  20.  
  21. For iD = 2 To 65536
  22. Select Case I & J & K & L
  23. Case D.Cells(iD, 7).Value >= I
  24. ligne = 10
  25. Case I > D.Cells(iD, 7).Value >= J
  26. ligne = 9
  27. Case J > D.Cells(iD, 7).Value >= K
  28. ligne = 8
  29. Case K > D.Cells(iD, 7).Value >= L
  30. ligne = 7
  31. Case D.Cells(iD, 7).Value < L
  32. ligne = 6
  33. Case Else
  34. ligne = -1
  35. End Select
  36.  
  37. If ligne > -1 Then
  38. D.Range(iD & ";" & 13).Copy A.Cells(iA, 1).Value
  39. e = A.Cells(iA, 1).Value
  40. g = g + e ' // g permet de stocker la somme
  41. h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
  42. iA = iA + 1
  43. R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
  44. R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
  45. End IF
  46. 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 :
  1. MsgBox I & J & K & L
:pfff: 
Voici la bonne syntaxe :
  1. Select Case D.Cells(iD, 7).Value
  2. Case Is >= I
  3. ligne = 10
  4. Case Is >= J
  5. ligne = 9
  6. Case Is >= K
  7. ligne = 8
  8. Case Is >= L
  9. ligne = 7
  10. Case Is < L
  11. ligne = 6
  12. Case Else
  13. ligne = -1
  14. End Select

A part qu'on voit tout de suite qu'il faut prendre le problème à l'envers :
  1. Select Case D.Cells(iD, 7).Value
  2. Case Is < L: ligne = 6
  3. Case Is >= L: ligne = 7
  4. Case Is >= K: ligne = 8
  5. Case Is >= J : ligne = 9
  6. Case Is >= I: ligne = 10
  7. End Select
Et la clause Case Else disparaît parce qu'on a traité tous les cas.
Ton code devient :
  1. Dim A, D, R As Worksheet
  2. Dim g, e, h As Long
  3. Dim iD, iA As Long
  4. Dim ligne As Long
  5.  
  6. Set A = Worksheets("Age Analysis" )
  7. Set R = Worksheets("Results" )
  8. Set D = Worksheets("Debit" )
  9.  
  10. iA = 1
  11. g = 0
  12. h = 0
  13.  
  14. For iD = 2 To 65536
  15. Select Case CDate(D.Cells(iD, 7).Value)
  16. Case Is >= DateAdd("m", -12, y): ligne = 7
  17. Case Is >= DateAdd("m", -9, y): ligne = 8
  18. Case Is >= DateAdd("m", -6, y): ligne = 9
  19. Case Is >= DateAdd("m", -3, y): ligne = 10
  20. Case Else: ligne = 6
  21. End Select
  22. e = D.Range(iD & ";" & 13).Value
  23. A.Cells(iA, 1).Value = e
  24. g = g + e ' // g permet de stocker la somme
  25. h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
  26. iA = iA + 1
  27. R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
  28. R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
  29. Next
Et la clause Case Else réapparaît :) 
EDIT: relire la ligne 23. [:patch]
Expert Programmation

Ah oui quand même !!!

c'est de la méga factorisation là !!
(merci pour le select case, je ne soupçonnait pas du tout cette erreur !!!)
Et il marche selon le même principe que les If en cascade alors...
merci.

je teste de suite et je reviens ....

Mais en tout cas Merci beaucoup !!!!
Expert Programmation

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 ?
Expert Programmation

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 ?
Expert Programmation

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...

  1. Dim datevaleur, colmontant, numcolonne As String
  2. Dim y As Date
  3. Dim A, D, R, M, C As Worksheet
  4. Dim g, e, h, iD, iA, iC, iM, ligne, vd, aie As Long
  5.  
  6. Set A = Worksheets("Age Analysis")
  7. Set R = Worksheets("Results")
  8. Set D = Worksheets("Debit")
  9. Set M = Worksheets("Sheet1")
  10. Set C = Worksheets("Credit")
  11.  
  12. iA = 1
  13. iC = 2
  14. iD = 2
  15. g = 0
  16. h = 0
  17. e = 0
  18.  
  19. datevaleur = Application.InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis ")
  20. If IsDate(datevaleur) Then
  21. y = CDate(datevaleur)
  22. MsgBox "You've written the value date :" & y, vbOKCancel
  23. If VB = yes Then
  24. numcolonne = Application.InputBox("Please enter the date column number for the date comparison :", " Column number's reference")
  25. If FormatNumber(numcolonne) Then
  26. vd = numcolonne
  27. MsgBox "You've entered column :" & vd, vbOKCancel
  28. If VB = yes Then
  29. colmontant = Application.InputBox("Please enter the Amount column number :", " Column number ")
  30. If FormatNumber(colmontant) Then
  31. aie = colmontant
  32. MsgBox "You've entered column :" & aie, vbOKCancel
  33. If VB = yes Then
  34. M.Cells.AutoFilter
  35. M.Cells.EntireColumn.AutoFit
  36. For iM = 1 To 65536
  37. If M.Cells.Text = "Credit" Then
  38. M.Range(iM & ":" & iM).Copy C.Cells(iC, 1)
  39. iC = iC + 1
  40. ElseIf M.Cells.Text = "Debit" Then
  41. M.Range(iM & ":" & iM).Copy D.Cells(iD, 1)
  42. iD = iD + 1
  43. End If
  44. Next
  45.  
  46. M.Rows("1:1").Copy D.Rows("1:1")
  47. M.Rows("1:1").Copy C.Rows("1:1")
  48. C.Columns("G:G").NumberFormat = "d/m/yyyy"
  49. D.Columns("G:G").NumberFormat = "d/m/yyyy"
  50. C.Cells.AutoFilter
  51. C.Cells.EntireColumn.AutoFit
  52. D.Cells.AutoFilter
  53. D.Cells.EntireColumn.AutoFit
  54.  
  55. For iD = 2 To 65536
  56. Select Case CDate((D.Cells(iD, vd).Value))
  57. Case Is >= DateAdd("m", -12, y): ligne = 7
  58. Case Is >= DateAdd("m", -9, y): ligne = 8
  59. Case Is >= DateAdd("m", -6, y): ligne = 9
  60. Case Is >= DateAdd("m", -3, y): ligne = 10
  61. Case Else: ligne = 6
  62. End Select
  63. e = D.Range(iD & ";" & aie).Value
  64. A.Cells(iA, 1).Value = e
  65. g = g + e ' // g permet de stocker la somme
  66. h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
  67. iA = iA + 1
  68. R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
  69. R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
  70. Next
  71.  
  72. For iC = 2 To 65536
  73. Select Case CDate((C.Cells(iC, vd).Value))
  74. Case Is >= DateAdd("m", -12, y): ligne = 7
  75. Case Is >= DateAdd("m", -9, y): ligne = 8
  76. Case Is >= DateAdd("m", -6, y): ligne = 9
  77. Case Is >= DateAdd("m", -3, y): ligne = 10
  78. Case Else: ligne = 6
  79. End Select
  80. e = C.Range(iC & ";" & aie).Value
  81. A.Cells(iA, 2).Value = e
  82. g = g + e ' // g permet de stocker la somme
  83. h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
  84. iA = iA + 1
  85. R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
  86. R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
  87. Next
  88.  
  89. Else: MsgBox "You have interrupted the Age Analysis. ", vbExclamation
  90. End If
  91. Else: MsgBox "You have not written a Number !", vbExclamation
  92. End If
  93. Else: MsgBox "You have interrupted the Age Analysis. ", vbExclamation
  94. End If
  95. Else: MsgBox "You have not written a number !", vbExclamation
  96. End If
  97. Else: MsgBox "You have interrupted the Age Analysis. ", vbExclamation
  98. End If
  99. Else: MsgBox "You have not written a date !", vbExclamation
  100. End If
Expert Programmation

bon, je pense avoir resolu le probleme des variables en changant le format...
j'ai inserer 2 nouvelles variables : ivb et iaie (format nombre)

par contre, autre probleme !!!!!
ca ne finira donc jamais !!!!!
ligne 80 !!! -> je suppose que c'est parceque la variable "e" est utilisee 2 fois de suite ?
Expert Programmation

en fait, ligne 63 aussi !!! donc ce n'est pas un problème de doublons !!!

bon, je re-poste le code....

  1. Dim datevaleur, colmontant, numcolonne, vd, aie As String
  2. Dim y As Date
  3. Dim A, D, R, M, C As Worksheet
  4. Dim g, e, h, iD, iA, iC, iM, ligne, ivd, iaie As Long
  5.  
  6. Set A = Worksheets("Age Analysis")
  7. Set R = Worksheets("Results")
  8. Set D = Worksheets("Debit")
  9. Set M = Worksheets("Sheet1")
  10. Set C = Worksheets("Credit")
  11.  
  12. iA = 1
  13. iC = 2
  14. iD = 2
  15. g = 0
  16. h = 0
  17. e = 0
  18.  
  19. datevaleur = Application.InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis ")
  20. If IsDate(datevaleur) Then
  21. y = CDate(datevaleur)
  22. MsgBox "You've written the value date :" & y, vbOKCancel
  23. If VB = yes Then
  24. numcolonne = Application.InputBox("Please enter the date column number for the date comparison :", " Column number's reference")
  25. If FormatNumber(numcolonne) Then
  26. vd = numcolonne
  27. MsgBox "You've entered column :" & vd, vbOKCancel
  28. If VB = yes Then
  29. colmontant = Application.InputBox("Please enter the Amount column number :", " Column number ")
  30. If FormatNumber(colmontant) Then
  31. aie = colmontant
  32. MsgBox "You've entered column :" & aie, vbOKCancel
  33. If VB = yes Then
  34. M.Cells.AutoFilter
  35. M.Cells.EntireColumn.AutoFit
  36. For iM = 1 To 65536
  37. If M.Cells.Text = "Credit" Then
  38. M.Range(iM & ":" & iM).Copy C.Cells(iC, 1)
  39. iC = iC + 1
  40. ElseIf M.Cells.Text = "Debit" Then
  41. M.Range(iM & ":" & iM).Copy D.Cells(iD, 1)
  42. iD = iD + 1
  43. End If
  44. Next
  45.  
  46. M.Rows("1:1").Copy D.Rows("1:1")
  47. M.Rows("1:1").Copy C.Rows("1:1")
  48. C.Columns("G:G").NumberFormat = "d/m/yyyy"
  49. D.Columns("G:G").NumberFormat = "d/m/yyyy"
  50. C.Cells.AutoFilter
  51. C.Cells.EntireColumn.AutoFit
  52. D.Cells.AutoFilter
  53. D.Cells.EntireColumn.AutoFit
  54. ivd = FormatNumber(vd)
  55. iae = FormatNumber(aie)
  56.  
  57. For iD = 2 To 65536
  58. Select Case CDate(D.Cells(iD, ivd).Value)
  59. Case Is >= DateAdd("m", -12, y): ligne = 7
  60. Case Is >= DateAdd("m", -9, y): ligne = 8
  61. Case Is >= DateAdd("m", -6, y): ligne = 9
  62. Case Is >= DateAdd("m", -3, y): ligne = 10
  63. Case Else: ligne = 6
  64. End Select
  65. e = D.Range(iD & ";" & iaie).Value
  66. A.Cells(iA, 1).Value = e
  67. g = g + e ' // g permet de stocker la somme
  68. h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
  69. iA = iA + 1
  70. R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
  71. R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
  72. Next
  73.  
  74. For iC = 2 To 65536
  75. Select Case CDate(C.Cells(iC, ivd).Value)
  76. Case Is >= DateAdd("m", -12, y): ligne = 7
  77. Case Is >= DateAdd("m", -9, y): ligne = 8
  78. Case Is >= DateAdd("m", -6, y): ligne = 9
  79. Case Is >= DateAdd("m", -3, y): ligne = 10
  80. Case Else: ligne = 6
  81. End Select
  82. e = C.Range(iC & ";" & iaie).Value
  83. A.Cells(iA, 2).Value = e
  84. g = g + e ' // g permet de stocker la somme
  85. h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
  86. iA = iA + 1
  87. R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
  88. R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
  89. Next
  90.  
  91. Else: MsgBox "You have interrupted the Age Analysis. ", vbExclamation
  92. End If
  93. Else: MsgBox "You have not written a Number !", vbExclamation
  94. End If
  95. Else: MsgBox "You have interrupted the Age Analysis. ", vbExclamation
  96. End If
  97. Else: MsgBox "You have not written a number !", vbExclamation
  98. End If
  99. Else: MsgBox "You have interrupted the Age Analysis. ", vbExclamation
  100. End If
  101. Else: MsgBox "You have not written a date !", vbExclamation
  102. End If


Merci beaucoup zeb de m'avoir aider jusqu'à présent...
Expert Programmation

Salut,

Je ne t'ai pas abandonné, je prenais de vraies vacances : 4 jours sans téléphone, ni internet :D 

Reprenons.
  1. 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. :pfff: 

Si tu ne précises pas le type d'une variable, VB considère que c'est un Variant. Ta ligne, devient explicitement :
  1. Dim datevaleur As Variant, colmontant As Variant, numcolonne As Variant, vd As Variant, aie As String
Je crois que ce n'est pas ce que tu voulais.

  1. datevaleur = Application.InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis " )
  2. MsgBox "You've written the value date :" & y, vbOKCancel
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 :
  1. datevaleur = Application.InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis " )
  2. Application.MsgBox "You've written the value date :" & y, vbOKCancel
  1. datevaleur = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis " )
  2. 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 :
  1. datevaleur = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis " )
  2. If Not IsDate(datevaleur) Then
  3. // ' Cas particulier : la date n'est pas bien saisie.
  4. MsgBox "You have not written a date !"
  5. Exit Sub
  6. End If
  7. // ' On continue
  8. ....


Si tu comptes te servir du résultat d'une MsgBox, programme-le comme suit :
  1. Dim code_retour As VBMsgBoxResult
  2. ' // Pour ne pas t'embêter, tu peux utiliser un Long
  3.  
  4. ' // vbOkCancelAbortRetryIgnoreYesNo n'existe pas !
  5. code_retour = MsgBox "Message", vbOkCancelAbortRetryIgnoreYesNo
  6. If code_retour = vbOk Then
  7. Else ...
  8.  
  9. ' // Mieux que les If Then Else imbriqués
  10. Select Case MsgBox "Message", vbOkCancelAbortRetryIgnoreYesNo
  11. Case vbOk : ' // C'est Ok
  12. Case vbCancel : ' // Annulé
  13. ....

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 :
  1. If MsgBox "Message", vbYesNo <> vbYes Then
  2. ' // Tu veux pas ?
  3. ' // Alors on s'en va !
  4. Exit Sub
  5. End If


----------------

Ligne 47
  1. M.Rows("1:1" )
M'ouais :/  C'est pas faux. Mais c'est moche !
Essaie Rows("1") ou mieux Rows(1). Pareil pour les deux lignes suivantes.

Ligne 65
  1. e = D.Range(iD & ";" & iaie).Value
Dis donc, tu sais te servir de Cells() alors ne t'embête pas à reconstruire des adresses pour Range() :pfff: 

----------------

Bon, sinon il est où ton problème ? :sol: 
Expert Programmation

le tel a la limite mais 4 jours sans internet !!! je sais pas comment tu fait, moi je me sens mal.... :D  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 ..... " ;) 
Expert Programmation

ouf... :D 

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... :cry: 
que de patience pour un petit programme de rien du tout :heink: 

Expert Programmation

J'attends de voir ton prochain code :D 
Parce que j'ai des choses à te proposer pour sa simplification.
Par exemple, t'es-tu rendu compte que tu parcours 2 fois ta feuille avec les boucles For des lignes 57 et 74, alors que la différence est minime. Y'a du boulot de factorisation énorme à faire ;) 
Expert Programmation

oui j'avais vu....
pas etonnant que ca rame... (en meme temps, les ordis du boulo... :sweat:  )

pour les factorisation.... suis nul.
je ne connait pas assez le code pour arriver a en faire...
je vais essayer tiens....

je compte sur ta correction et tes conseils !!!
Expert Programmation

bon, je suis de retour...
j'ai un petit peu travailler sur le code.

le voici:

  1. Dim datevaleur As String
  2. Dim colmontant As String
  3. Dim numcolonne As String
  4. Dim debitcred As String
  5. Dim vd As String
  6. Dim aie As String
  7. Dim e As String
  8. Dim y As Date
  9. Dim D As Worksheet
  10. Dim R As Worksheet
  11. Dim M As Worksheet
  12. Dim C As Worksheet
  13. Dim g As Long
  14. Dim h As Long
  15. Dim iD As Long
  16. Dim iC As Long
  17. Dim iM As Long
  18. Dim ligne As Long
  19. Dim ivd As Long
  20. Dim iaie As Long
  21. Dim dc As Long
  22.  
  23.  
  24. Set R = Worksheets("Results")
  25. Set D = Worksheets("Debit")
  26. Set M = Worksheets("Sheet1")
  27. Set C = Worksheets("Credit")
  28.  
  29. iC = 2
  30. iD = 2
  31. g = 0
  32. h = 0
  33. e = 0
  34.  
  35. datevaleur = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis ")
  36. If Not IsDate(datevaleur) Then ' Cas particulier : la date n'est pas bien saisie.
  37. MsgBox "You have not written a date !"
  38. Exit Sub
  39. End If
  40. numcolonne = InputBox("Please enter the date column number for the date comparison :", " Column number's reference")
  41. If Format(numcolonne) <> Number Then
  42. MsgBox "You have not written a number !"
  43. Exit Sub
  44. End If
  45. colmontant = InputBox("Please enter the Amount column number :", " Column number ")
  46. If Format(colmontant) <> Number Then
  47. MsgBox "You have not written a number !"
  48. Exit Sub
  49. End If
  50. debitcred = InputBox("Please enter the D/C column number :", " Column number ")
  51. If Format(colmontant) <> Number Then
  52. MsgBox "You have not written a number !"
  53. Exit Sub
  54. End If
  55.  
  56. 'UserForm1.Show
  57. MsgBox "You've written the value date :" & y, vbOKCancel
  58. MsgBox "You've entered column :" & vd, vbOKCancel
  59. MsgBox "You've entered column :" & aie, vbOKCancel
  60. MsgBox "You've entered column :" & dc, vbOKCancel
  61.  
  62. M.Cells.AutoFilter
  63. M.Cells.EntireColumn.AutoFit
  64.  
  65. For iM = 1 To 65536
  66. If M.Cells(iM, dc).Text = "Credit" Then
  67. M.Range(iM & ":" & iM).Copy C.Cells(iC, 1)
  68. iC = iC + 1
  69. ElseIf M.Cells(iM, dc).Text = "Debit" Then
  70. M.Range(iM & ":" & iM).Copy D.Cells(iD, 1)
  71. iD = iD + 1
  72. End If
  73. Next
  74.  
  75. M.Rows(1).Copy D.Rows(1)
  76. M.Rows(1).Copy C.Rows(1)
  77. C.Columns("vd:vd").NumberFormat = "d/m/yyyy"
  78. D.Columns("vd:vd").NumberFormat = "d/m/yyyy"
  79. C.Cells.AutoFilter
  80. C.Cells.EntireColumn.AutoFit
  81. D.Cells.AutoFilter
  82. D.Cells.EntireColumn.AutoFit
  83. ivd = FormatNumber(vd)
  84. iaie = FormatNumber(aie)
  85.  
  86. For iD = 2 To 65536
  87. Select Case CDate(D.Cells(iD, ivd).Value & C.Cells(iC, ivd).Value)
  88. Case Is >= DateAdd("m", -12, y): ligne = 7
  89. Case Is >= DateAdd("m", -9, y): ligne = 8
  90. Case Is >= DateAdd("m", -6, y): ligne = 9
  91. Case Is >= DateAdd("m", -3, y): ligne = 10
  92. Case Else: ligne = 6
  93. End Select
  94. If Cells(iD, iaie).Text <> "" Then
  95. e = D.Cells(iD, iaie).Value
  96. g = g + e ' // g permet de stocker la somme
  97. h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
  98. R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
  99. R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
  100. End If
  101. If Cells(iC, iaie).Text <> "" Then
  102. e = C.Cells(iC, iaie).Value
  103. g = g + e ' // g permet de stocker la somme
  104. h = h + 1 ' // compte le nombre d'operations passe entre les dates definies
  105. R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
  106. R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
  107. End If
  108. Next
  109.  
  110. R.PrintPreview
  111. C.PrintPreview
  112. D.PrintPreview
  113. M.PrintPreview
  114.  
  115. Set wordApp = Nothing 'libère la mémoire
Expert Programmation

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 :cry: 

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 !!! :D 

Expert Programmation

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.
  1. ' // Code moche, lent, qui nécessite plein de calculs
  2. M.Range(iM & ":" & iM)....
  3. C.Columns("vd:vd" )....
  4. ' // Code efficace
  5. M.Rows(iM)....
  6. C.Columns(ivd)....


  1. ivd = FormatNumber(vd)
M'enfin ? :/ 
FormatNumber permet de transformer un nombre en chaîne de caractères selon un certain format. Tu cherches à faire le contraire !
  1. ivd = CLong(vd)
Encore une fois, tu as trouvé CDate() mais pas CLng() !

  1. DateAdd("m", -12, y)
Ces calculs sont faits 65535*4 fois. C'est beaucoup. Utilise quatre variables et sors ces calculs de la boucle !

  1. If Cells(iD, iaie).Text <> "" Then
  2. e = D.Cells(iD, iaie).Value
  3. g = g + e
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.
  1. e = D.Cells(iD, iaie).Value
  2. If e <> "" Then
  3. 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.
Expert Programmation

Citation :

  1. 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 !!! :D  )
Par contre je n'ai aucune idee de comment rassembler mes boucles .. :heink: 
bon je poste le code sans les declarations de variables... ca fera toujours 25 lignes en moins !!!

isnumeric()... ca parait evident !!!!
idem pour Clng() !!!

  1. datevaleur = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis ")
  2. If Not IsDate(datevaleur) Then ' Cas particulier : la date n'est pas bien saisie.
  3. MsgBox "You have not written a date !"
  4. Exit Sub
  5. End If
  6. numcolonne = InputBox("Please enter the date column number for the date comparison :", " Column number's reference")
  7. If Not IsNumeric(numcolonne) Then
  8. MsgBox "You have not written a number !"
  9. Exit Sub
  10. End If
  11. colmontant = InputBox("Please enter the Amount column number :", " Column number ")
  12. If Not IsNumeric(colmontant) Then
  13. MsgBox "You have not written a number !"
  14. Exit Sub
  15. End If
  16. debitcred = InputBox("Please enter the D/C column number :", " Column number ")
  17. If Not IsNumeric(colmontant) Then
  18. MsgBox "You have not written a number !"
  19. Exit Sub
  20. End If
  21.  
  22. 'UserForm1.Show
  23. MsgBox "You've written the value date :" & y, vbOKCancel
  24. MsgBox "You've entered column :" & vd, vbOKCancel
  25. MsgBox "You've entered column :" & aie, vbOKCancel
  26. MsgBox "You've entered column :" & dc, vbOKCancel
  27.  
  28. M.Cells.AutoFilter
  29. M.Cells.EntireColumn.AutoFit
  30.  
  31. For iM = 1 To 65536
  32. If M.Cells(iM, dc).Text = "Credit" Then
  33. M.Rows(iM).Copy C.Cells(iC, 1)
  34. iC = iC + 1
  35. ElseIf M.Cells(iM, dc).Text = "Debit" Then
  36. M.Rows(iM).Copy D.Cells(iD, 1)
  37. iD = iD + 1
  38. End If
  39. Next
  40.  
  41. M.Rows(1).Copy D.Rows(1)
  42. M.Rows(1).Copy C.Rows(1)
  43. C.Columns(ivd).NumberFormat = "d/m/yyyy"
  44. D.Columns(ivd).NumberFormat = "d/m/yyyy"
  45. C.Cells.AutoFilter
  46. C.Cells.EntireColumn.AutoFit
  47. D.Cells.AutoFilter
  48. D.Cells.EntireColumn.AutoFit
  49. ivd = CLng(vd)
  50. iaie = CLng(aie)
  51.  
  52. Select Case CDate(D.Cells(iD, ivd).Value)
  53. Case Is >= DateAdd("m", -12, y): ligne = 7
  54. Case Is >= DateAdd("m", -9, y): ligne = 8
  55. Case Is >= DateAdd("m", -6, y): ligne = 9
  56. Case Is >= DateAdd("m", -3, y): ligne = 10
  57. Case Else: ligne = 6
  58. End Select
  59.  
  60. Select Case CDate(C.Cells(iC, ivd).Value)
  61. Case Is >= DateAdd("m", -12, y): lnc = 7
  62. Case Is >= DateAdd("m", -9, y): lnc = 8
  63. Case Is >= DateAdd("m", -6, y): lnc = 9
  64. Case Is >= DateAdd("m", -3, y): lnc = 10
  65. Case Else: lnc = 6
  66. End Select
  67.  
  68. For iD = 2 To 65536
  69. e = D.Cells(iD, iaie).Value
  70. If e <> "" Then
  71. gD = gD + e ' // g permet de stocker la somme
  72. hD = hD + 1 ' // compte le nombre d'operations passe entre les dates definies
  73. R.Cells(ligne, 6).Value = g ' // affiche la somme dans la cellule de la feuille Results
  74. R.Cells(ligne, 5).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
  75. End If
  76. e = C.Cells(iC, iaie).Value
  77. If e <> "" Then
  78. gC = gC + e ' // g permet de stocker la somme
  79. hC = hC + 1 ' // compte le nombre d'operations passe entre les dates definies
  80. R.Cells(lnc, 11).Value = g ' // affiche la somme dans la cellule de la feuille Results
  81. R.Cells(lnc, 10).Value = h ' // affiche le nombre de date dans la cellulle de la feuille results
  82. End If
  83. Next
  84.  
  85. R.PrintPreview
  86. C.PrintPreview
  87. D.PrintPreview
  88. M.PrintPreview
  89.  
  90. Set wordApp = Nothing 'libère la mémoire

Expert Programmation

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.)

  1. y = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis ")
  2. If Not IsDate(y) Then ' Cas particulier : la date n'est pas bien saisie.
  3. MsgBox "You have not written a date !"
  4. Exit Sub
  5. End If
  6. vd = InputBox("Please enter the date column number for the date comparison :", " Column number's reference")
  7. If Not IsNumeric(vd) Then
  8. MsgBox "You have not written a number !"
  9. Exit Sub
  10. End If
  11. aie = InputBox("Please enter the Amount column number :", " Column number ")
  12. If Not IsNumeric(aie) Then
  13. MsgBox "You have not written a number !"
  14. Exit Sub
  15. End If
  16. dc = InputBox("Please enter the D/C column number :", " Column number ")
  17. If Not IsNumeric(dc) Then
  18. MsgBox "You have not written a number !"
  19. Exit Sub
  20. End If
  21.  
  22. MsgBox "You've written the value date :" & y, vbOKCancel
  23. MsgBox "You've entered column :" & vd, vbOKCancel
  24. MsgBox "You've entered column :" & aie, vbOKCancel
  25. MsgBox "You've entered column :" & dc, vbOKCancel
  26.  
  27. M.Cells.AutoFilter
  28. M.Cells.EntireColumn.AutoFit
  29.  
  30. For iM = 1 To 65536
  31. If M.Cells(iM, dc).Value = "Credit" Then
  32. M.Rows(iM).Copy C.Cells(iC, 1)
  33. iC = iC + 1
  34. ElseIf M.Cells(iM, dc).Value = "Debit" Then
  35. M.Rows(iM).Copy D.Cells(iD, 1)
  36. iD = iD + 1
  37. End If
  38. Next
  39.  
  40. ivd = CLng(vd)
  41. iaie = CLng(aie)
  42. M.Rows(1).Copy D.Rows(1)
  43. M.Rows(1).Copy C.Rows(1)
  44. C.Columns(ivd).NumberFormat = "d/m/yyyy"
  45. D.Columns(ivd).NumberFormat = "d/m/yyyy"
  46. C.Cells.AutoFilter
  47. C.Cells.EntireColumn.AutoFit
  48. D.Cells.AutoFilter
  49. D.Cells.EntireColumn.AutoFit
  50.  
  51.  
  52. Select Case CDate(D.Cells(iD, ivd).Value)
  53. Case Is >= DateAdd("m", -12, y): ligne = 7
  54. Case Is >= DateAdd("m", -9, y): ligne = 8
  55. Case Is >= DateAdd("m", -6, y): ligne = 9
  56. Case Is >= DateAdd("m", -3, y): ligne = 10
  57. Case Else: ligne = 6
  58. End Select
  59.  
  60. Select Case CDate(C.Cells(iC, ivd).Value)
  61. Case Is >= DateAdd("m", -12, y): lnc = 7
  62. Case Is >= DateAdd("m", -9, y): lnc = 8
  63. Case Is >= DateAdd("m", -6, y): lnc = 9
  64. Case Is >= DateAdd("m", -3, y): lnc = 10
  65. Case Else: lnc = 6
  66. End Select
  67.  
  68. For iD = 2 To 65536
  69. e = D.Cells(iD, iaie).Value
  70. If e <> "" Then
  71. gD = gD + e ' // g permet de stocker la somme
  72. hD = hD + 1 ' // compte le nombre d'operations passe entre les dates definies
  73. R.Cells(ligne, 6).Value = gD ' // affiche la somme dans la cellule de la feuille Results
  74. R.Cells(ligne, 5).Value = hD ' // affiche le nombre de date dans la cellulle de la feuille results
  75. End If
  76. e = C.Cells(iC, iaie).Value
  77. If e <> "" Then
  78. gC = gC + e ' // g permet de stocker la somme
  79. hC = hC + 1 ' // compte le nombre d'operations passe entre les dates definies
  80. R.Cells(lnc, 11).Value = gC ' // affiche la somme dans la cellule de la feuille Results
  81. R.Cells(lnc, 10).Value = hC ' // affiche le nombre de date dans la cellulle de la feuille results
  82. End If
  83. Next
  84.  
  85. R.PrintPreview
  86. C.PrintPreview
  87. D.PrintPreview
  88. M.PrintPreview
  89.  
  90. Set wordApp = Nothing 'libère la mémoire
Expert Programmation

Pour cela, il faudrait utiliser la balise [fixed]. Mais elle ne marche pas terrible non plus :/ 

  1. y = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis " )
  2. If Not IsDate(y) Then ' Cas particulier : la date n'est pas bien saisie.
  3. MsgBox "You have not written a date !"
  4. Exit Sub
  5. End If
  6. vd = InputBox("Please enter the date column number for the date comparison :", " Column number's reference" )
  7. If Not IsNumeric(vd) Then
  8. MsgBox "You have not written a number !"
  9. Exit Sub
  10. End If
  11. aie = InputBox("Please enter the Amount column number :", " Column number " )
  12. If Not IsNumeric(aie) Then
  13. MsgBox "You have not written a number !"
  14. Exit Sub
  15. End If
  16. dc = InputBox("Please enter the D/C column number :", " Column number " )
  17. If Not IsNumeric(dc) Then
  18. MsgBox "You have not written a number !"
  19. Exit Sub
  20. End If
  21.  
  22. MsgBox "You've written the value date :" & y, vbOKCancel
  23. MsgBox "You've entered column :" & vd, vbOKCancel
  24. MsgBox "You've entered column :" & aie, vbOKCancel
  25. MsgBox "You've entered column :" & dc, vbOKCancel
  26. ' // Tout ça, c'est ok.
  27.  
  28. M.Cells.AutoFilter
  29. M.Cells.EntireColumn.AutoFit
  30. ' // blabla
  31.  
  32. For iM = 1 To 65536
  33. If M.Cells(iM, dc).Value = "Credit" Then
  34. M.Rows(iM).Copy C.Cells(iC, 1)
  35. iC = iC + 1
  36. ElseIf M.Cells(iM, dc).Value = "Debit" Then
  37. M.Rows(iM).Copy D.Cells(iD, 1)
  38. iD = iD + 1
  39. End If
  40. Next
  41. ' // Cette boucle pourrait être la seule !
  42.  
  43. ivd = CLng(vd)
  44. iaie = CLng(aie)
  45.  
  46. M.Rows(1).Copy D.Rows(1)
  47. M.Rows(1).Copy C.Rows(1)
  48. ' // Ah, on a pourant commencer à 1 tout à l'heure.
  49.  
  50. C.Columns(ivd).NumberFormat = "d/m/yyyy"
  51. D.Columns(ivd).NumberFormat = "d/m/yyyy"
  52. C.Cells.AutoFilter
  53. C.Cells.EntireColumn.AutoFit
  54. D.Cells.AutoFilter
  55. D.Cells.EntireColumn.AutoFit
  56. ' // blabla
  57.  
  58. Select Case CDate(D.Cells(iD, ivd).Value)
  59. Case Is >= DateAdd("m", -12, y): ligne = 7
  60. Case Is >= DateAdd("m", -9, y): ligne = 8
  61. Case Is >= DateAdd("m", -6, y): ligne = 9
  62. Case Is >= DateAdd("m", -3, y): ligne = 10
  63. Case Else: ligne = 6
  64. End Select
  65.  
  66. Select Case CDate(C.Cells(iC, ivd).Value)
  67. Case Is >= DateAdd("m", -12, y): lnc = 7
  68. Case Is >= DateAdd("m", -9, y): lnc = 8
  69. Case Is >= DateAdd("m", -6, y): lnc = 9
  70. Case Is >= DateAdd("m", -3, y): lnc = 10
  71. Case Else: lnc = 6
  72. End Select
  73. ' // Mais non, bougre d'âne, tu as besoin de iD et iC qui sont la variable qui boucle !
  74.  
  75. For iD = 2 To 65536
  76. e = D.Cells(iD, iaie).Value
  77. If e <> "" Then
  78. gD = gD + e ' // g permet de stocker la somme
  79. hD = hD + 1 ' // compte le nombre d'operations passe entre les dates definies
  80. R.Cells(ligne, 6).Value = gD ' // affiche la somme dans la cellule de la feuille Results
  81. R.Cells(ligne, 5).Value = hD ' // affiche le nombre de date dans la cellulle de la feuille results
  82. End If
  83. e = C.Cells(iC, iaie).Value
  84. If e <> "" Then
  85. gC = gC + e ' // g permet de stocker la somme
  86. hC = hC + 1 ' // compte le nombre d'operations passe entre les dates definies
  87. R.Cells(lnc, 11).Value = gC ' // affiche la somme dans la cellule de la feuille Results
  88. R.Cells(lnc, 10).Value = hC ' // affiche le nombre de date dans la cellulle de la feuille results
  89. End If
  90. Next
  91.  
  92. R.PrintPreview
  93. C.PrintPreview
  94. D.PrintPreview
  95. M.PrintPreview
  96. ' // Blabla
  97.  
  98. Set wordApp = Nothing 'libère la mémoir
  99. ' // 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.
  1. Dim y_moins_douze As Date
  2. Dim y_moins_neuf As Date
  3. Dim y_moins_six As Date
  4. Dim y_moins_trois As Date
  5.  
  6. y_moins_douze = DateAdd("m", -12, y)
  7. y_moins_neuf = DateAdd("m", -9, y)
  8. y_moins_six = DateAdd("m", -6, y)
  9. y_moins_trois = DateAdd("m", -3, y)
  10.  
  11. For i = 2 To 65536
  12. Select Case CDate(D.Cells(i, ivd).Value)
  13. Case Is >= y_moins_douze: ligne = 7
  14. Case Is >= y_moins_neuf: ligne = 8
  15. Case Is >= y_moins_six: ligne = 9
  16. Case Is >= y_moins_trois: ligne = 10
  17. Case Else: ligne = 6
  18. End Select
  19. e = D.Cells(i, iaie).Value
  20. If e <> "" Then
  21. gD = gD + e
  22. hD = hD + 1
  23. R.Cells(ligne, 6).Value = gD
  24. R.Cells(ligne, 5).Value = hD
  25. End If
  26.  
  27. Select Case CDate(C.Cells(i, ivd).Value)
  28. Case Is >= y_moins_douze: ligne = 7
  29. Case Is >= y_moins_neuf: ligne = 8
  30. Case Is >= y_moins_six: ligne = 9
  31. Case Is >= y_moins_trois: ligne = 10
  32. Case Else: ligne = 6
  33. End Select
  34. e = C.Cells(i, iaie).Value
  35. If e <> "" Then
  36. gC = gC + e ' // g permet de stocker la somme
  37. hC = hC + 1 ' // compte le nombre d'operations passe entre les dates definies
  38. R.Cells(lnc, 11).Value = gC ' // affiche la somme dans la cellule de la feuille Results
  39. R.Cells(lnc, 10).Value = hC ' // affiche le nombre de date dans la cellulle de la feuille results
  40. End If
  41. 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 :
  1. Sub DistributionDesDonnées(ws_source As Worksheet, ws_credit As Worksheet, ws_debit As Worksheet, ... )
  2. Dim row_source As Range
  3. Dim row_credit As Range
  4. Dim row_debit As Range
  5.  
  6. Set row_credit = ws_credit.Rows(1)
  7. Set row_debit = ws_debit.Rows(1)
  8.  
  9. For Each row_source In ws_source.Rows
  10. Select Case row.Cells(dc).Value
  11. Case "Credit"
  12. row_source.Copy row_credit
  13. Set row_credit = row_credit.Offset(1)
  14. Case "Debit"
  15. M.Rows(iM).Copy D.Cells(iD, 1)
  16. Set row_credit = row_credit.Offset(1)
  17. End If
  18. Next
  19. End Sub


Et si on se contentait de cette unique boucle ?
  1. Sub DistributionDesDonnées(ws_source As Worksheet, _
  2. ws_credit As Worksheet, _
  3. ws_debit As Worksheet, _
  4. ws_result As Worksheet, _
  5. date_ref As Date, _
  6. dc_colnum As Integer, _
  7. date_colnum As Integer, _
  8. amount_colnum As Integer)
  9. Dim row_source As Range
  10. Dim row_credit As Range
  11. Dim row_debit As Range
  12. Dim date_(1 To 4) As Date
  13. Dim i As Integer
  14. Dim i0 As Integer
  15. Dim valeur As Long
  16. Dim sums_credit(1 To 5) As Long, _
  17. Dim sums_debit(1 To 5) As Long, _
  18. Dim ops_credit(1 To 5) As Long, _
  19. Dim ops_debit(1 To 5) As Long, _
  20.  
  21. For i = 1 To 4
  22. date_(i) = DateAdd("m", -i * 3, date_ref)
  23. Next
  24.  
  25. Set row_credit = ws_credit.Rows(1)
  26. Set row_debit = ws_debit.Rows(1)
  27.  
  28. For Each row_source In ws_source.Rows
  29. Select Case row.Cells(dc_colnum).Value
  30. Case "Credit"
  31. row_source.Copy row_credit
  32. If IsNumeric(row_credit.Cells(amount_colnum).Value) And _
  33. CLng(row_credit.Cells(amount_colnum).Value) > 0 _
  34. Then
  35. i0 = 5
  36. For i = 4 To 1 Step -1
  37. If CDate(row_credit.Cells(date_colnum).Value) >= date_(i) Then
  38. i0 = i
  39. Exit For
  40. End If
  41. Next
  42. ops_credit(i0) = ops_credit(i0) + 1
  43. sums_credit(i0) = sums_credit(i0) + CLng(row_credit.Cells(amount_colnum).Value)
  44. End If
  45. Set row_credit = row_credit.Offset(1)
  46. Case "Debit"
  47. row_source.Copy row_debit
  48. If IsNumeric(row_debit.Cells(amount_colnum).Value) And _
  49. CLng(row_debit.Cells(amount_colnum).Value) > 0 _
  50. Then
  51. i0 = 5
  52. For i = 4 To 1 Step -1
  53. If CDate(row_debit.Cells(date_colnum).Value) >= date_(month) Then
  54. i0 = i
  55. Exit For
  56. End If
  57. Next
  58. ops_debit(i0) = ops_debit(i0) + 1
  59. sums_debit(i0) = sums(i0) + CLng(row_debit.Cells(amount_colnum).Value)
  60. End If
  61. Set row_debit = row_debit.Offset(1)
  62. End Select
  63. Next
  64.  
  65. For i = 1 To 5
  66. ws_result.Cells(i, ?).Value = sums_credit(i)
  67. ws_result.Cells(i, ?).Value = sums_debit(i)
  68. ws_result.Cells(i, ?).Value = ops_credit(i)
  69. ws_result.Cells(i, ?).Value = ops_debit(i)
  70. Next0
  71. End Sub


Bon, c'est cool non :sol: 
Mais moi, j'ai écrit deux fois la même chose. Et ça, ça m'énerve :fou: 
Je ne veux pas avoir à faire plus d'une fois une même chose. L'ordinateur est fait pour ça, non ?
Alors factorisons :D 

  1. Enum dc_enum
  2. Debit
  3. Credit
  4. End Enum
  5.  
  6. Sub DistributionDesDonnées(ws_source As Worksheet, _
  7. ws_credit As Worksheet, _
  8. ws_debit As Worksheet, _
  9. ws_result As Worksheet, _
  10. date_ref As Date, _
  11. dc_colnum As Integer, _
  12. date_colnum As Integer, _
  13. amount_colnum As Integer)
  14. Dim dc_type As dc_enum
  15. Dim row_source As Range
  16. Dim row_target(Debit To Credit) As Range
  17. Dim date_(1 To 4) As Date
  18. Dim i As Integer
  19. Dim i0 As Integer
  20. Dim valeur As Long
  21. Dim sums(Debit To Credit, 1 To 5) As Long, _
  22. Dim opes(Debit To Credit, 1 To 5) As Long, _
  23.  
  24. For i = 1 To 4
  25. date_(i) = DateAdd("m", -i * 3, date_ref)
  26. Next
  27.  
  28. Set row_target(Credit) = ws_credit.Rows(1)
  29. Set row_target(Debit) = ws_debit.Rows(1)
  30.  
  31. For Each row_source In ws_source.Rows
  32. Select Case row.Cells(dc_colnum).Value
  33. Case "Credit" : dc_type = Credit
  34. Case "Debit" : dc_type = Debit
  35. End Select
  36.  
  37. row_source.Copy row_target(dc_type)
  38. If IsNumeric(row_target(dc_type).Cells(amount_colnum).Value) And _
  39. CLng(row_target(dc_type).Cells(amount_colnum).Value) > 0 _
  40. Then
  41. i0 = 5
  42. For i = 4 To 1 Step -1
  43. If CDate(row_target(dc_type).Cells(date_colnum).Value) >= date_(i) Then
  44. i0 = i
  45. Exit For
  46. End If
  47. Next
  48. opes(dc_type, i0) = opes(dc_type, i0) + 1
  49. sums(dc_type, i0) = sums(dc_type, i0) + CLng(row_target(dc_type).Cells(amount_colnum).Value)
  50. End If
  51. Set row_target(dc_type) = row_target(dc_type).Offset(1)
  52. Next
  53.  
  54. For dc_type = Debit To Credit
  55. For i = 1 To 5
  56. ws_result.Cells(i, ?).Value = sums(dc_type, i)
  57. ws_result.Cells(i, ?).Value = opes(dc_type, i)
  58. Next
  59. Next
  60. End Sub
Expert Programmation

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 !!!! :D 
ca veux tout dire je pense ...

Merci, mille fois merci pour tout zeb !!!!! :ange: 
je dois mechament monopoliser ton temps ! :D 
Expert Programmation

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...

  1. If IsNumeric(row_target(dc_type).Cells(amount_colnum).Value) And _
  2. CLng(row_target(dc_type).Cells(amount_colnum).Value) > 0 _
  3. Then


2- ensuite: ln 42 je ne comprend pas ce que fait la boucle for qui remonte a l'envers.... :heink: 

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...
  1. For i = 1 To 5
  2. ws_result.Cells(i, 6).Value = sums(dc_type, i)
  3. ws_result.Cells(i, 5).Value = ops(dc_type, i)
  4. 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 !!!) :D 
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..... :cry: 
enfin je crois
Expert Programmation

1 - :pt1cable:  J'ai corrigé mon code. 'scuse-moi... :( 
Bien vu de ta part ;) 

2 - Eh, eh !! :fille:  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

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

Pour x = 10, qu'affiche le premier ? Le second ?
Maintenant, regarde pourquoi j'ai pris la boucle à l'envers.

3 - :pt1cable:  J'ai corrigé mon code. 'scuse-moi... :( 
Mal vu de ta part :o 

4 - Arf. C'est pour ça que j'ai laissé des ?
  1. For dc_type = Debit To Credit
  2. For i = 1 To 5
  3. ws_result.Cells(i, Iff(dc_type = Debit, 6, 11)).Value = sums(dc_type, i)
  4. ...
  5. Next
  6. Next

Trop fort, non ? :sol: 

  1. 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 [:patch]
Expert Programmation

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) :lol:  .... je penche pour :-3 pour le premier et -12 pour le deuxieme....
YOUHOU, j'ai pige !!!!! :D 

(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 :

  1. 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 ...... :ange:  :ange:  :ange: 
Expert Programmation

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) :lol:  .... je penche pour :-3 pour le premier et -12 pour le deuxieme....
YOUHOU, j'ai pige !!!!! :D 
Mais il se moque de moi, celui-là ! :fou: 

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)) :??: 
Mais pourquoi veux-tu mettre Range() à la place de Cells(). La programmation, ce n'est pas l'invocation de formules magiques. Il faut comprendre ce que l'on fait. Aide-toi avant tout de l'aide d'Excel pour savoir ce que fait une fonction, une méthode, ce que renvoie une propriété, etc.

Citation :
autre chose... c'est quoi ca ? : iff
RTFM !

Bon, je reviens sur ton problème de mismatch.
Voici le prototype de notre fonction :
  1. Sub DistributionDesDonnées(ws_source As Worksheet, _
  2. ws_credit As Worksheet, _
  3. ws_debit As Worksheet, _
  4. ws_result As Worksheet, _
  5. date_ref As Date, _
  6. dc_colnum As Integer, _
  7. date_colnum As Integer, _
  8. amount_colnum As Integer)
Tu as compris à quoi servait chaque paramètre ? Tu mets quoi comme valeur dans chacun ?

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 !
Expert Programmation

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 !!! :lol: 

Expert Programmation

>>dsl de t'avoir froisse..
mais non, je le prends bien. ;) 

Citation :
Iff() <--> IIf()
:pt1cable: 
[:patch]

Citation :
mais par contre je n'ai pas encore trouve comment on lui dit de passer a la ligne suivante...

Euh.... C'est quoi déjà le problème ?
Expert Programmation

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 :cry: 



Expert Programmation

Ah oui, évidement.

  1. Dim is_credit_debit As Boolean
  2.  
  3. ...
  4.  
  5. For Each row_source In ws_source.Rows
  6. is_credit_debit = True
  7. Select Case row.Cells(dc_colnum).Value
  8. Case "Credit" : dc_type = Credit
  9. Case "Debit" : dc_type = Debit
  10. Case Else : is_credit_debit = False
  11. End Select
  12.  
  13. If Is_credit_debit Then
  14. ...
  15. Enf If
  16. Next


Euh, ... t'aurais pu trouver tout seul, non ?
Expert Programmation

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 )
Expert Programmation

bon, je reviens desespere sur ce forum.... :cry: 
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... :heink: 

un petit coup de pouce ?, une indication ? :ange: 

  1. For i = 1 To 4
  2. date_(i) = DateAdd("m", -i * 3, date_ref)
  3. Next
  4.  
  5. Set row_target(Credit) = ws_credit.Rows(1)
  6. Set row_target(Debit) = ws_debit.Rows(1)
  7.  
  8. For Each row_source In ws_source.Rows
  9. is_credit_debit = True
  10. Select Case Rows.Cells(dc_colnum).Value
  11. Case "Credit": dc_type = Credit
  12. Case "Debit": dc_type = Debit
  13. Case Else: is_credit_debit = False
  14. End Select
  15.  
  16. If is_credit_debit Then
  17. row_source.Copy row_target(dc_type)
  18. If IsNumeric(row_target(dc_type).Cells(amount_colnum).Value) And CLng(row_target(dc_type).Cells(amount_colnum).Value) > 0 Then
  19. i0 = 5
  20. For i = 4 To 1 Step -1
  21. If CDate(row_target(dc_type).Cells(date_colnum).Value) >= date_(i) Then
  22. i0 = i
  23. End If
  24. Next
  25. ops(dc_type, i0) = ops(dc_type, i0) + 1
  26. sums(dc_type, i0) = sums(dc_type, i0) + CLng(row_target(dc_type).Cells(amount_colnum).Value)
  27. End If
  28. Set row_target(dc_type) = row_target(dc_type).Offset(1)
  29. End If
  30. Next
  31.  
  32. For dc_type = Debit To Credit
  33. For i = 1 To 5
  34. ws_result.Cells(i, IIf(dc_type = Debit, 6, 11)).Value = sums(dc_type, i)
  35. ws_result.Cells(i, IIf(dc_type = Debit, 5, 10)).Value = ops(dc_type, i)
  36. Next
  37. Next
Expert Programmation

  1. Dim c_count As Long
  2. Dim d_count As Long
  3. Dim o_count As Long
  4.  
  5. c_count = 0
  6. d_count = 0
  7. o_count = 0
  8.  
  9. [...]
  10.  
  11. For Each row_source In ws_source.Rows
  12. is_credit_debit = True
  13. Select Case Rows.Cells(dc_colnum).Value
  14. Case "Credit": dc_type = Credit: c_count = c_count + 1
  15. Case "Debit": dc_type = Debit: d_count = d_count + 1
  16. Case Else: is_credit_debit = False: o_count = o_count + 1
  17. End Select
  18. [...]
  19. Next
  20. MsgBox "Credit: " & c_count & vbCR & _
  21. "Débit: " & b_count & vbCR & _
  22. "Autres: " & o_count,,"Trouvés"
Alors ?
Expert Programmation

Ben non, ce n'est pas la copie qui pose problème, c'est la détection !

  1. Case "Credit"
  2. Case "Debit"
T'est sûr de ce que tu cherches ? Y'a pas d'espace, d'accent, de différence de majuscule/minuscule ?
Expert Programmation

c'est genial, ca marche !!!!
Citation :

J'ai fait une petite coquille dans mon premier code, tu l'as corrigée, mais mal


ca veux juste dire que j'ai encore des progres a faire :) 

en tout cas merci beaucoup de t'etre penche sur mon probleme. je fini le code et le poste en entier pour la communaute !
[:_tom_:2]


Expert Programmation

merci beaucoup zeb pour ton aide.

code final :
  1. Dim ws_source As Worksheet
  2. Dim ws_credit As Worksheet
  3. Dim ws_debit As Worksheet
  4. Dim ws_result As Worksheet
  5. Dim date_ref As Date
  6. Dim dc_colnum As Integer
  7. Dim date_colnum As Integer
  8. Dim amount_colnum As Integer
  9. Dim is_credit_debit As Boolean
  10.  
  11. Dim dc_type As dc_enum
  12. Dim row_source As Range
  13. Dim row_target(Debit To Credit) As Range
  14. Dim date_(1 To 4) As Date
  15. Dim i As Integer
  16. Dim i0 As Integer
  17. Dim valeur As Long
  18. Dim sums(Debit To Credit, 1 To 5) As Long
  19. Dim ops(Debit To Credit, 1 To 5) As Long
  20. Dim c_count As Long
  21. Dim d_count As Long
  22. Dim o_count As Long
  23.  
  24. Set ws_source = Worksheets("Sheet1")
  25. Set ws_credit = Worksheets("Credit")
  26. Set ws_debit = Worksheets("Debit")
  27. Set ws_result = Worksheets("Result")
  28.  
  29. c_count = 0
  30. d_count = 0
  31.  
  32. ws_source.Select
  33. ws_source.Rows(1).Copy ws_debit.Rows(1)
  34. ws_source.Rows(1).Copy ws_credit.Rows(1)
  35.  
  36. date_ref = InputBox("Please, write the Value Date of the Age Analysis (dd/mm/yyyy) :", "Date of reference for the Age Analysis ")
  37. If Not IsDate(date_ref) Then
  38. MsgBox "You have not written a date !"
  39. Exit Sub
  40. End If
  41. date_colnum = InputBox("Please enter the date column number for the date comparison :", " Column number's reference")
  42. If Not IsNumeric(date_colnum) Then
  43. MsgBox "You have not written a number !"
  44. Exit Sub
  45. End If
  46. amount_colnum = InputBox("Please enter the Amount column number :", " Column number ")
  47. If Not IsNumeric(amount_colnum) Then
  48. MsgBox "You have not written a number !"
  49. Exit Sub
  50. End If
  51. dc_colnum = InputBox("Please enter the D/C column number :", " Column number ")
  52. If Not IsNumeric(dc_colnum) Then
  53. MsgBox "You have not written a number !"
  54. Exit Sub
  55. End If
  56.  
  57. MsgBox "You've entered the value date :" & date_ref & vbCr & _
  58. "You've entered Date column :" & date_colnum & vbCr & _
  59. "You've entered Amount column :" & amount_colnum & vbCr & _
  60. "You've entered D/C column :" & dc_colnum, vbOKCancel
  61.  
  62. ws_source.Cells.AutoFilter
  63. ws_source.Cells.EntireColumn.AutoFit
  64.  
  65. For i = 1 To 4
  66. date_(i) = DateAdd("m", -i * 3, date_ref)
  67. Next
  68.  
  69. Set row_target(Credit) = ws_credit.Rows(2)
  70. Set row_target(Debit) = ws_debit.Rows(2)
  71.  
  72. For Each row_source In ws_source.Rows
  73. is_credit_debit = True
  74. Select Case row_source.Cells(dc_colnum).Value
  75. Case "Credit": dc_type = Credit: c_count = c_count + 1
  76. Case "credit": dc_type = Credit: c_count = c_count + 1
  77. Case "C": dc_type = Credit: c_count = c_count + 1
  78. Case "c": dc_type = Credit: c_count = c_count + 1
  79. Case "Debit": dc_type = Debit: d_count = d_count + 1
  80. Case "debit": dc_type = Debit: d_count = d_count + 1
  81. Case "D": dc_type = Debit: d_count = d_count + 1
  82. Case "d": dc_type = Debit: d_count = d_count + 1
  83. Case Else: is_credit_debit = False
  84. End Select
  85.  
  86. If is_credit_debit Then
  87. row_source.Copy row_target(dc_type)
  88. If IsNumeric(row_target(dc_type).Cells(amount_colnum).Value) And CLng(row_target(dc_type).Cells(amount_colnum).Value) > 0 Then
  89. i0 = 5
  90. For i = 4 To 1 Step -1
  91. If CDate(row_target(dc_type).Cells(date_colnum).Value) >= date_(i) Then
  92. i0 = i
  93. End If
  94. Next
  95. ops(dc_type, i0) = ops(dc_type, i0) + 1
  96. sums(dc_type, i0) = sums(dc_type, i0) + CLng(row_target(dc_type).Cells(amount_colnum).Value)
  97. End If
  98. Set row_target(dc_type) = row_target(dc_type).Offset(1)
  99. End If
  100. Next
  101.  
  102. MsgBox "Credit: " & c_count & vbCr & _
  103. "Debit: " & d_count & vbCr & _
  104. "Total : " & c_count + d_count, , "Trouvés"
  105.  
  106.  
  107. For dc_type = Debit To Credit
  108. For i = 1 To 5
  109. ws_result.Cells(i, IIf(dc_type = Debit, 6, 12)).Value = sums(dc_type, i)
  110. ws_result.Cells(i, IIf(dc_type = Debit, 5, 11)).Value = ops(dc_type, i)
  111. Next
  112. Next
  113.  
  114. ws_credit.Columns(date_colnum).NumberFormat = "d/m/yyyy"
  115. ws_debit.Columns(date_colnum).NumberFormat = "d/m/yyyy"
  116. ws_credit.Cells.AutoFilter
  117. ws_credit.Cells.EntireColumn.AutoFit
  118. ws_debit.Cells.AutoFilter
  119. ws_debit.Cells.EntireColumn.AutoFit
  120. ws_result.Cells(19, 8).Value = date_ref
  121.  
  122. demand = MsgBox("Go to the print preview ?", vbOKCancel)
  123.  
  124. If vbOK = True Then
  125. ws_result.PrintPreview
  126. ws_credit.PrintPreview
  127. ws_debit.PrintPreview
  128. ws_source.PrintPreview
  129. End If



Expert Programmation

:) 

Bon, j'ai tout relu, et j'ai deux trois bricoles pour toi.

  1. demand = MsgBox("Go to the print preview ?", vbOKCancel)
  2. If vbOK = True Then

:pt1cable: 

  1. Select Case row_source.Cells(dc_colnum).Value
  2. Case "Credit": dc_type = Credit: c_count = c_count + 1
  3. Case "credit": dc_type = Credit: c_count = c_count + 1
  4. Case "C": dc_type = Credit: c_count = c_count + 1
  5. Case "c": dc_type = Credit: c_count = c_count + 1
Non, non et non. Si tu veux considérer plusieurs cas, énumère-les sur la même ligne :
  1. Select Case row_source.Cells(dc_colnum).Value
  2. 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 :
  1. Select Case LCase(row_source.Cells(dc_colnum).Value)
  2. 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() :
  1. Function Capitalise(ByVal s As String) As String
  2. Capitalise = UCase(Left(s, 1)) + LCase(Mid(s, 2))
  3. End Function
  4.  
  5. [..]
  6. Select Case Capitalise(row_source.Cells(dc_colnum).Value)
  7. 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 :fou:  - 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 :
  1. Function IsSpace(ByVal s As String) As Boolean
  2. IsSpace = Left(s, 1) = " " Or _
  3. Left(s, 1) = vbTab Or _
  4. Left(s, 1) = vbCr Or _
  5. Left(s, 1) = vbLf
  6. End Function
  7.  
  8. Function Normalise(ByVal s As String) As String
  9. Const lettres_d = "åäãâáàÅÄÃÂÁÀëêéèËÊÉÈïîíìÏÎÍÌöõôóòÖÕÔÓÒüûúùÜÛÚÙÿýŸÝñçÑÇ"
  10. Const lettres_0 = "aaaaaaAAAAAAeeeeEEEEiiiiIIIIoooooOOOOOuuuuUUUUyyYYncNC"
  11.  
  12. Dim i As Integer
  13. Dim p As Integer
  14. Dim s0 As String
  15. Dim c As String
  16. Dim c_prev As String
  17.  
  18. s0 = ""
  19. s = Trim(s)
  20. c_prev = " "
  21. For i = 1 To Len(s)
  22. c = Mid(s, i, 1)
  23. If IsSpace(c) Then
  24. c = ""
  25. If Not IsSpace(c_prev) Then c = " "
  26. Else
  27. p = InStr(lettres_d, c)
  28. If p > 0 Then c = Mid(lettres_0, p, 1)
  29. End If
  30. c_prev = c
  31. s0 = s0 + c
  32. Next
  33. Normalise = s0
  34. End Function
Lassé par la pub ? Créez un compte