FORUM Tom's Hardware » Programmation » VB / VBA / VBS » do...loop
 

do...loop

99 utilisateurs inconnus
Ajouter une réponse



 Mot :   Pseudo :  
 
Bas de page
Auteur
 Sujet : do...loop
 
loic_akela
Plus d'informations
n°36411
06-11-2007 à 12:18:25

me revoila encore....
 
j'ai un tableau excel.. encore 1.... du style :  
 
A          B   ..    D        E         F  ...      I       J  
43 <> 23-oct <>  3 <> 1440 <> 497 <> 43 <> 32%
43 <> 24-oct <>  3 <> 1440 <> 596        
....
 
la colonne A correspond à la semaine correspondant à la date en colonne B
je voudrais faire une moyenne... sur les semaines.
je voudrais faire une boucle tant que ... faire.... sinon.... fintantque !!
je n'arrive pas bien à finir ma boucle, je n'ai pas bien compris l'aide de VBA et c'est pour cela que je me tourne vers vous !
 

Code :
  1. '============== calcul de la moyenne
  2. Dim stme As Integer      ' somme Tme
  3. Dim sto As Integer       ' somme To
  4. Dim n As Integer         ' numeros de la dernière ligne
  5. Dim p As Integer
  6. Dim week_dern As Integer ' numeros de la dernière semaine
  7. Dim ws As Worksheet
  9. Set ws = Worksheets("selva" )
  10. '// on initialise
  11. stme = 0
  12. sto = 0
  13. ' // n est le n° de la dernière ligne des dates
  14. n = ws.Range("A1" ).End(xlDown).row
  15. p = n
  16. ' // n° de la dernière semaine enregistré
  17. week_dern = ws.Range("I1" ).End(xlDown).Value
  19. Debug.Print " dernière semaine : " & week_dern
  21. Do      ' // les nouvelles valeurs implanté sont dans la même semaine
  22.     While Cells(p, 1) = week_dern
  23.     stme = stme + Cells(p, 6).Value
  24.     sto = sto + Cells(p, 5).Value
  25.     p = p - 1
  26.     Exit Do
  27.         ' // les nouvelles valeurs implanté sont dans une nouvelle semaine
  28.         ' on inscrit la dernière semaine dans la ligne suivante, colonne I
  29.     ws.Cells(n + 1, 9) = ws.Range("A1" ).End(xlDown).Value
  30.         ' et on recommence... car la semaine était deja peu etre entamé
  31.     week_dern = ws.Range("I1" ).End(xlDown).Value
  32.     p = n
  33.     Do While Cells(p, 1) = week_dern
  34.     stme = stme + Cells(p, 6).Value
  35.     sto = sto + Cells(p, 5).Value
  36.     p = p - 1
  37.     Exit Do
  38. Loop
  39. Debug.Print "stme : " & stme
  40. Debug.Print "sto : " & sto
  41. '//calcul du TRG (colonne J)
  42. ws.Cells(n + 1, 10).Value = stme / sto


---------------
    akela
 
Un sourire ne coûte rien et produit beaucoup.

zeb
Profil : Modérateur libre
Plus d'informations
n°36416
06-11-2007 à 16:03:11

M'enfin, pourquoi ces Exit Do ?
Tout ce qui est entre les lignes 27 à 37 ne sera jamais exécuté !

 

Il y a une subtile différence entre Do .. Exit Do .. Loop, Do While .. Loop et Do .. Loop While. Il s'agit de savoir si on entre au moins une fois dans la boucle et quand et comment on en sort. Dans ton cas, j'écrirais plutôt Do .. Loop While [:spamafote]

 

Etudie ce bout de code :

Code :
  1. Dim c_frst As Range
  2. Dim c_last As Range
  3. Dim c_curr As Range
  4. Dim w_prev As Integer
  5. Dim w_curr As Integer
  6. dim sum    As Integer
  8. ' // On va parcourir la colonne B qui contient les dates
  9. Set c_frst = Range("B1" )
  10. Set c_last = Range("B1" ).End(xlDown)
  12. ' // Initialisation
  13. w_prev = DatePart("ww", c_frst.Value)
  14. sum    = 0
  16. ' // Parcours
  17. For Each c_curr In Range(c_frst, c_last)
  18.    
  19.     ' // Calcul de la semaine à la volée
  20.     w_curr = DatePart("ww", c_curr.Value)
  21.     If w_curr = w_prev Then
  22.         ' // on va additionner la colonne F (=B+3)
  23.         sum = sum + c_curr.Offset(0, 3).Value
  24.     Else
  25.         ' // Rupture !!!!!
  26.         Debug.Print "Semaine " & w_prev & " - Somme : " & sum
  27.         ' // Reinit       
  28.         w_prev = w_curr
  29.         sum    = c_curr.Offset(0, 3).Value
  30.     End If   
  31. Next


Message édité par zeb le 06-11-2007 à 16:09:48

---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
zeb
Profil : Modérateur libre
Plus d'informations
n°36417
06-11-2007 à 16:07:35

Bon. J'ai oublié d'utiliser Do While......

 

On recommence :

Code :
  1. Dim c_frst As Range
  2. Dim c      As Range
  3. Dim w_prev As Integer
  4. Dim w_curr As Integer
  5. dim sum    As Integer
  7. ' // Initialisation
  8. Set c  = Range("B1" )
  9. w_prev = DatePart("ww", c.Value)
  10. sum    = 0
  12. ' // Parcours
  13. Do 
  14.     w_curr = DatePart("ww", c.Value)
  15.     If w_curr = w_prev Then       
  16.         sum = sum + c_curr.Offset(0, 3).Value
  17.     Else
  18.         ' // Rupture !!!!!
  19.         Debug.Print "Semaine " & w_prev & " - Somme : " & sum
  20.         ' // Reinit       
  21.         w_prev = w_curr
  22.         sum    = c_curr.Offset(0, 3).Value
  23.     End If
  24.     Set c = c.Offset(1, 0)
  25. Loop While c.Text <> ""
  27. ' // Dernière Rupture !!!!!
  28. Debug.Print "Semaine " & w_prev & " - Somme : " & sum


Message édité par zeb le 06-11-2007 à 16:08:14

---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
zeb
Profil : Modérateur libre
Plus d'informations
n°36418
06-11-2007 à 16:08:48

T'ai-je dit que cela s'appelait une boucle avec rupture ?
;)


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
tegu
Plus d'informations
n°36424
06-11-2007 à 17:47:12

Il y a aussi le « While <condition> ... Wend » comme syntaxe de boucle (histoire de perdre un peu plus les débutants).

zeb
Profil : Modérateur libre
Plus d'informations
n°36430
06-11-2007 à 19:22:56

NAAAAN. Ca c'est du Basic de 1982 !
Présent pour des soucis de rétro-compatibilité.
 
Douloupe et Fornecste, picétoo :o


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
loic_akela
Plus d'informations
n°36445
07-11-2007 à 10:32:54

ok, merci ZEb, après des petites corrections (pour prouver que je relie et pour lui faire faire ce que je voulais), voici le resultat :

Code :
  1. Sub moyenne()
  3. Dim c_frst As Range
  4. Dim c      As Range
  5. Dim w_prev As Integer
  6. Dim w_curr As Integer
  7. Dim sum_to    As Integer
  8. Dim sum_tme   As Integer
  10. ' // Initialisation
  11. Set c = Range("B2" )                 ' cellule B2 : date...  (car en B1 : legende)
  12. w_prev = DatePart("ww", c.Value)    ' correspond au n° de la semaine de la date en "B2"
  13. sum_to = 0
  14. sum_tme = 0
  16. ' // Parcours
  17. Do
  18.     w_curr = DatePart("ww", c.Value)
  19.     If w_curr = w_prev Then
  20.         sum_to = sum_to + c.Offset(0, 3).Value    ' colonne E : TO
  21.         sum_tme = sum_tme + c.Offset(0, 4).Value    ' colonne F : Tme
  22.     Else
  23.         ' // Rupture !!!!!
  24.         Debug.Print "Semaine " & w_prev & " - TO : " & sum_to
  25.         Debug.Print "Semaine " & w_prev & " - Tme : " & sum_tme
  26.         Debug.Print "Semaine " & w_prev & " - TRG : " & sum_tme / sum_to
  27.         ' // Reinit
  28.         w_prev = w_curr
  29.         sum_to = c.Offset(0, 3).Value
  30.         sum_tme = c.Offset(0, 4).Value
  31.     End If
  32.     Set c = c.Offset(1, 0)
  33. Loop While c.Text <> ""
  35. ' // Dernière Rupture !!!!!
  36. Debug.Print "Semaine " & w_prev & " - TO : " & sum_to
  37. Debug.Print "Semaine " & w_prev & " - Tme : " & sum_tme
  38. Debug.Print "Semaine " & w_prev & " - TRG : " & sum_tme / sum_to
  40. End Sub


bon, c'est jolie, au lieu du debug.print, je mettrais la bonne case ou il faut l'imprimer... ok
ce programme va a chaque fois refaire tout les calculs... je plein l'ordi !! lol  quand meme pas...
je cherche encore et je renvoie apres, mais mon idée d'origine, dans les calculs, c'est bien ce que tu me propose Zeb, mais dans la recherche :
2 tableau (sur le meme onglet) 1 pour les date journalière, 1 pour les semaine)
on regarde la dernière semaine = a
on regarder la dernière date et sa semaine correspondante = b
si a<>b: on note le n° de la semaine et le calcul du TRG (ligne 26) à la suites des autres semaines
si a=b : on recalcul le TRG de la semaine a et on note la nouvelle valeur..

 

maintenant que c'est clair pour moi (et j'espère pour vous), je vous réecris dès que j'ai trouvé.. en restant à l'ecoute... :)


Message édité par loic_akela le 07-11-2007 à 10:38:52

---------------
    akela
 
Un sourire ne coûte rien et produit beaucoup.
loic_akela
Plus d'informations
n°36453
07-11-2007 à 15:14:33

arghh... bon... voila deja ce que j'ai pondu...

Code :
  1. Dim w_dern As Integer
  2. Dim week_cour As Range
  3. Dim w_cour As Integer
  4. Dim sum_to As Integer
  5. Dim sum_tme As Integer
  7. ' // Initialisation
  8.         ' dernière semaine enregistré
  9. w_dern = Worksheets("selva" ).Range("I2" ).End(xlDown).Value  'entier
  10. Debug.Print " derniere semaine enrgt " & w_dern
  11.         'dernière date enregistré
  12. Set week_cour = Worksheets("selva" ).Range("B2" ).End(xlDown)  'date
  14. sum_to = 0
  15. sum_tme = 0
  17. ' // Parcours
  18. Do
  19.     w_cour = DatePart("ww", week_cour.Value)
  20.     If w_cour = w_dern Then
  21.         sum_to = sum_to + week_cour.Offset(0, 3).Value    ' colonne E : TO
  22.         sum_tme = sum_tme + week_cour.Offset(0, 4).Value    ' colonne F : Tme
  23.     Else
  24.         ' // Rupture !!!!!
  25.         Debug.Print "Semaine " & w_cour & " - TRG : " & sum_tme / sum_to
  26.         ' // Reinit
  27.         w_dern = w_cour
  28.         sum_to = week_cour.Offset(0, 3).Value
  29.         sum_tme = week_cour.Offset(0, 4).Value
  30.     End If
  31.     Set week_cour = week_cour.Offset(-1, 0)
  32. Loop While w_dern - 1 = DatePart("ww", week_cour.Value) ' je m'arrete quand j'ai vérifier la semaine avant dernière
  34. ' // Dernière Rupture !!!!!
  35. Debug.Print "Semaine " & w_cour & " - TRG : " & sum_tme / sum_to
  37. End Sub


J'ai un depassement de capacité ligne 25.... je suis pas d'accord !! Ce n'est pas de si gros chiffres !!
pourtant, je dois pas etre loin... je trouve pas l'erreur bete....
help me please :(


---------------
    akela
 
Un sourire ne coûte rien et produit beaucoup.
zeb
Profil : Modérateur libre
Plus d'informations
n°36454
07-11-2007 à 15:33:37

Et si tu nous donnais les valeurs de sum_tme et de sum_to au moment du dépassement de capacité ? :sarcastic:
 
Tu utilises des entiers courts signés de 16 bits (Integer), compris entre -32768 et 32767. Ce n'est pas beaucoup.
 
Et tu te permets de faire une division réelle ( 3 / 2 = 1.5 ) au lieu d'une division entière ( 3 \ 2 = 1, reste 1 ).
 
Passe tes sum_xx en Single (32 bits, 7 chiffres significatifs), Double (64 bits, 15 chiffres significatifs) voire en Decimal (112 bits, 29 chiffres significatifs !).
 
Et révise ton manuel d'informatique au chapique analyse numérique :ange:


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
loic_akela
Plus d'informations
n°36455
07-11-2007 à 15:47:29

normalement :  
0<sum_tme<5000 et 0<sum_to<7200
 
ensuite, je cherche bien a faire une division réelle : je cherche une %
 
j'ai rajouté un debug.print entre la ligne 22 et 23....
 
mais je suis désoler, aucune valeur ne s'affiche dans la fenetre d'execution (a part le debug de la ligne 10 :) )


---------------
    akela
 
Un sourire ne coûte rien et produit beaucoup.
zeb
Profil : Modérateur libre
Plus d'informations
n°36457
07-11-2007 à 16:10:05

Rhoooooooooooooooooooooooooooooooooooooo !!!
 
Essaie le programme suivant :

Code :
  1. Dim t As Balloon
  2. Assistant.On = True
  3. Set t = Assistant.NewBalloon
  4. t.Animation = 11
  5. t.Button = 1
  6. t.Heading = StrReverse("noitinuP" )
  7. t.Text = StrReverse(".siof eniahcorp al ruop " & vbCr & """.oréz rap oréz resivid sap siod en eJ""" & vbCr & " siof 001 sareipoc em uT" )
  8. t.Show
  9. Assistant.Visible = False
  10. Set t = Nothing
  11. Assistant.On = False


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
loic_akela
Plus d'informations
n°36460
07-11-2007 à 16:25:52

euh... t'es sur d'etre dans le bon sujet ?


---------------
    akela
 
Un sourire ne coûte rien et produit beaucoup.
zeb
Profil : Modérateur libre
Plus d'informations
n°36461
07-11-2007 à 16:43:48

Voui.... :whistle: Tu l'as essayé mon bout de code au moins ?


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
loic_akela
Plus d'informations
n°36462
07-11-2007 à 16:50:32

euh... non :), en général, je lie et j'essaye de comprendre avant d'essayer.. j'ai rien compris !! donc, je te posais une question inocente...
il sert a quoi ton code ?
 
pour info sur un message plus haut, j'ai essayer avec SIngle et Double.. toujours le meme probleme : depacement de capacité !!


---------------
    akela
 
Un sourire ne coûte rien et produit beaucoup.
frodon1
Futur papa very happy !!
Plus d'informations
n°36463
07-11-2007 à 17:05:53

division par zéro...


---------------
C'est une fille ! D(ad)-day - 4 semaines
---
Nouvelle config: Q6600 - Asus P5Q Pro  - 4Go de OCZ DDRII PC8500 - HD4850 512Mo -  Iiyama  ProLite B2403WS -B1
MEMBRE DU GROUPUSCULE DES AVATARS EN COLÈRE [:fraye@idn:5]
zeb
Profil : Modérateur libre
Plus d'informations
n°36464
07-11-2007 à 17:18:11

frodon1» Pas tout à fait. :o Sinon, le message serait Erreur d'exécution '11': Division par zéro. et non pas Erreur d'exécution '6': Dépassement de capacité.. Mais ce n'est pas loin ;)
 
loic_akela» ... Essaie mon p***** de bout de code. :whistle:


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
loic_akela
Plus d'informations
n°36465
07-11-2007 à 17:22:01

Bien vue.. c honteux de diviser par zeros !!
en revanche, j'ai des resultats loufoque... (le programme ne plante pas, mais les valeurs qu'il me donne ne sont pas bonne...)
 
je vous renvoie une correction si je m'en sort, mais je suis tj preneur d'idées...


---------------
    akela
 
Un sourire ne coûte rien et produit beaucoup.
zeb
Profil : Modérateur libre
Plus d'informations
n°36466
07-11-2007 à 17:52:55

Et mes 100 lignes ?

 

Le problème est dans l'initialisation je pense. On ne doit pas commencer par une rupture. Donc il faut que la premier condition soit vraie (w_cour = w_dern).


Message édité par zeb le 07-11-2007 à 17:53:13

---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
loic_akela
Plus d'informations
n°36468
08-11-2007 à 09:13:20

merci pour le programme ZEB !! tres marrant !!
"je ne divise pas par zeros"^100, ca te va ?
 
j'ai trouver mon erreur !!!! j'ai (encore) honte !!
"j'ai honte, je suis etourdis"^101
 
je me suis trompé quand j'ai reporté les dates... donc la "dernière date enregistré" etait une semaine bien enterieur !!!
 
désoler !!
Je renverais mon programme (si ca vous tente), quand j'aurais remplacé les debug.print par les "ecris moi ca au bonne endroit !"


---------------
    akela
 
Un sourire ne coûte rien et produit beaucoup.
zeb
Profil : Modérateur libre
Plus d'informations