Actualité informatique
Test comparatif matériel informatique
Jeux vidéo
Astuces informatique
Vidéo
Télécharger
Services en ligne
Forum informatique
01Business



|||-  

V.B.A , programmation d'une grande boucle.

 

1 utilisateur anonyme
Ajouter une réponse
 

 
Page photos
 
     
Vider la liste des messages à citer
 
 Page :
1
Auteur
 Sujet :

V.B.A , programmation d'une grande boucle.

Prévenir les modérateurs en cas d'abus 
MartineDum​es
martinedumes
  1. Posté le 16/05/2013 à 17:28:58  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
Bonsoir,

 Etudiante ayant des cours d'informatique, je souhaiterais avoir votre aide et vos recommandations pour réaliser un programme VBA.
 Cette macro est un petit jeu à 3 joueurs (présents en A1,A2,A3).
 Pour résumer,ces joueurs donnent une estimation d'un objet (ex paire de Ray-Ban) et celui qui se rapproche le plus du prix réel de l'objet voit son nom apparaitre en B1. Les 2 joueurs restant doivent estimer un second objet (iphone) et le nom du gagnant doit se retrouver en B2.

 Sur le papier c'est quelque chose d'assez logique, mais lorsqu'il faut passer à la programmation, mes lacunes en VBA font surfasse..

 J'étais parti sur l'idée de mettre un msgbox demandant au 3 joueurs le prix des lunettes (120e par ex), un inputbox pour demander le prix au joueur 1, puis le prix au joueur 2 etc. Ensuite, pouvoir faire la différence entre le prix réel et le prix proposé pour trouver celui qui a la plus petite différence.
 Je n'arrive pas a savoir quelles boucles utilisés, et de quelle manière.

 Merci de m'avoir lu, je reste à votre disposition pour tout autre question !

willyplaisir
Expert Excel Habitué (de 5 000 à 9 999 messages postés)
  1. Posté le 17/05/2013 à 09:14:35  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
bonjour martine,

 tu peux déjà essayer de faire ton organigramme avec tes conditions,boucles...pour voir si tu as bien analysé ton problème;
 ensuite viendra la programmation en VBA qui n'est pas très compliquée.

 Aides-toi et les les internautes t'aideront  :lol:
 donc on attend ta logique.
 Je suis capable de faire ton programme de A à Z, mais je te laisse travailler tes neurones.

 :hello:

(Publicité)
martinedumes
  1. Posté le 17/05/2013 à 10:23:37  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
Bonjour,

 Je vous envoie ce que j'ai préalablement fait pour que vous ayez idée des petits problèmes auxquels je suis confrontés.

 Sub différence()
 Dim a As Double, b As Double, c As Double, joueur1 As Double, joueur2 As Double, joueur3 As Double
 MsgBox ("L'objectif est de trouver la meilleure estimation d'un objet" )
 MsgBox ("Vous devez trouver le prix d'une paire de lunette Ray-Ban" )
 joueur1 = InputBox("Donnez une estimation" )
 joueur2 = InputBox("Donnez une estimation" )
 joueur3 = InputBox("Donnez une estimation" )
 a = joueur1 - 120
 b = joueur2 - 120
 c = joueur3 - 120
 If a < b And a < c Then
 MsgBox ("C'est le joueur 1 qui remporte la première sélection" )
 Range("B1" ).Value = A1
 End If
 If b < a And b < c Then
 MsgBox ("C'est le joueur 2 qui remporte la première selection" )
 Range("B1" ).Value = A2
 End If
 If c < a And c < b Then
 MsgBox ("C'est le joueur 3 qui remporte la première sélection" )
 Range("B1" ).Value = A3
 End If
 End Sub

 Le programme fonctionne et désigne le candidat le plus proche, cependant je ne sais pas quoi faire lorsqu'il y a une  égalité. De plus, il faut que ce programme ce réitère une seconde fois pour pouvoir dégager 2 finalistes, où devrais-je ajouter des lignes de programme ? Dernière petite question sur mon travail, la fonction Range que j'utilise ne fonctionne pas, je veux que le candidat sélectionné et qui a son nom en A1,A2,ou A3 retrouve son nom en B1.
 Merci de m'avoir lu et désolé pour le pavé .. !

willyplaisir
Expert Excel Habitué (de 5 000 à 9 999 messages postés)
  1. Posté le 17/05/2013 à 12:23:11  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
bonjour,

 pas très pratique d'afficher des boites message à chaque saisie, je t'ai fait un fichier démo qui utilise la macro évènementielle qui te permet de continuer la saisie des estimations, alors que ton programme s'arrête dès le 1er test (la saisie des 3 joueurs une fois).

 http://cjoint.com/?CErnmiW9p1t


 attention! au range("A3" ) ou [A3]

 Sub différence()
 Dim a As Double, b As Double, c As Double, joueur1 As Double, joueur2 As Double, joueur3 As Double
 MsgBox ("L'objectif est de trouver la meilleure estimation d'un objet" )
 MsgBox ("Vous devez trouver le prix d'une paire de lunette Ray-Ban" )
 joueur1 = InputBox("Donnez une estimation" )
 joueur2 = InputBox("Donnez une estimation" )
 joueur3 = InputBox("Donnez une estimation" )
 a = joueur1 - 120
 b = joueur2 - 120
 c = joueur3 - 120
 If a < b And a < c Then
 MsgBox ("C'est le joueur 1 qui remporte la première sélection" )
 Range("B1" ).Value = range("A1" )
 End If
 If b < a And b < c Then
 MsgBox ("C'est le joueur 2 qui remporte la première selection" )
 Range("B1" ).Value = range("A2" )
 End If
 If c < a And c < b Then
 MsgBox ("C'est le joueur 3 qui remporte la première sélection" )
 Range("B1" ).Value = range("A3" )
 End If
 End Sub

 prévoir une condition  pour les cas a=b afficher les 2 noms
 cas a=c idem et cas b=c

 suite de ton programme
 quand la condition est remplie pour le montant du 1er objet
 tu feras la même logique avec le 2è objet
 si joueur1 a trouvé le 1 : test sur joueurs 2 et 3
 si joueur2 a trouvé le 1 : test sur joueurs 1 et 3
 si joueur3 a trouvé le 1 : test sur joueurs 1 et 2
 :jap:

martinedumes
  1. Posté le 17/05/2013 à 14:19:05  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
cd

(Publicité)
martinedumes
  1. Posté le 17/05/2013 à 14:19:06  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
Bonjour,

 Je vous envoie ce que j'ai préalablement fait pour que vous ayez idée des petits problèmes auxquels je suis confrontés.

 Sub différence()
 Dim a As Double, b As Double, c As Double, joueur1 As Double, joueur2 As Double, joueur3 As Double
 MsgBox ("L'objectif est de trouver la meilleure estimation d'un objet" )
 MsgBox ("Vous devez trouver le prix d'une paire de lunette Ray-Ban" )
 joueur1 = InputBox("Donnez une estimation" )
 joueur2 = InputBox("Donnez une estimation" )
 joueur3 = InputBox("Donnez une estimation" )
 a = joueur1 - 120
 b = joueur2 - 120
 c = joueur3 - 120
 If a < b And a < c Then
 MsgBox ("C'est le joueur 1 qui remporte la première sélection" )
 Range("B1" ).Value = A1
 End If
 If b < a And b < c Then
 MsgBox ("C'est le joueur 2 qui remporte la première selection" )
 Range("B1" ).Value = A2
 End If
 If c < a And c < b Then
 MsgBox ("C'est le joueur 3 qui remporte la première sélection" )
 Range("B1" ).Value = A3
 End If
 End Sub

 Le programme fonctionne et désigne le candidat le plus proche, cependant je ne sais pas quoi faire lorsqu'il y a une  égalité. De plus, il faut que ce programme ce réitère une seconde fois pour pouvoir dégager 2 finalistes, où devrais-je ajouter des lignes de programme ? Dernière petite question sur mon travail, la fonction Range que j'utilise ne fonctionne pas, je veux que le candidat sélectionné et qui a son nom en A1,A2,ou A3 retrouve son nom en B1.
 Merci de m'avoir lu et désolé pour le pavé .. !

martinedumes
  1. Posté le 17/05/2013 à 14:43:02  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
Merci beaucoup de votre aide. Votre programme est vraiment trop avancé par rapport à mon niveau !
 Je vous ai fait joindre par fichier excel, ce que j'aimerais obtenir au final. C'est quelque chose de plutôt sobre, vous verrez.
 Pour ce qui concerne les égalités, je vais dire qu'on ne peut donner le même prix.
 Mes lacunes persistent, pour le deuxième objet c'est toujours un casse tête pour faire "disparaitre" celui qui a été déjà sélectionné !

 Merci énormément pour votre aide,
 Martine.

 http://cjoint.com/?CErpXU4E0FX

willyplaisir
Expert Excel Habitué (de 5 000 à 9 999 messages postés)
  1. Posté le 17/05/2013 à 16:26:41  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
bonjour,


 j'ai amélioré ton programme à toi de le tester:
 http://cjoint.com/?CErryUP1Ihm



 Sub différence()
 Dim a As Double, b As Double, c As Double, joueur1 As Double, joueur2 As Double, joueur3 As Double
 'participation de willy le 17 mai 2013
 '-----------------------------​-----------------
 'mettre tes données en debut de programme
 objet1 = "paire de lunette Ray-Ban"
 prix1 = 120

 objet2 = "Vélo"
 prix2 = 350
 '-----------------------------​------------------

 MsgBox "Vous devez trouver le prix " & objet1, , "L'objectif est de trouver la meilleure estimation d'un objet "
 Range("D4:D5" ).ClearContents

 On Error Resume Next
 debut1:
 joueur1 = InputBox("Donnez une estimation", Range("B4" ))
 If joueur1 = 0 Then GoTo debut1

 debut2:
 joueur2 = InputBox("Donnez une estimation", Range("B5" ))
 If joueur2 = 0 Then GoTo debut2

 debut3:
 joueur3 = InputBox("Donnez une estimation", Range("B6" ))
 If joueur3 = 0 Then GoTo debut3

 a = Abs(joueur1 - prix1)
 b = Abs(joueur2 - prix1)
 c = Abs(joueur3 - prix1)

 If a = 0 Then MsgBox "Bravo! " & Range("B4" ), , " tu as trouvé le juste Prix=" & prix1: Range("D4" ).Value = Range("B4" ): j1 = 1: GoTo suite
 If b = 0 Then MsgBox "Bravo! " & Range("B5" ), , "tu as trouvé le juste Prix=" & prix1: Range("D4" ).Value = Range("B5" ): j2 = 1: GoTo suite
 If c = 0 Then MsgBox "Bravo! " & Range("B6" ), , "tu as trouvé le juste Prix=" & prix1: Range("D4" ).Value = Range("B6" ): j3 = 1: GoTo suite

 If a < b And a < c Then
 MsgBox ("C'est le joueur 1 qui remporte la première sélection" ), vbInformation, Range("A1" )
 Range("D4" ).Value = Range("B4" ): j1 = 1
 End If

 If b < a And b < c Then
 MsgBox ("C'est le joueur 2 qui remporte la première selection" ), vbInformation, Range("A2" )
 Range("D4" ).Value = Range("B5" ): j2 = 1
 End If

 If c < a And c < b Then
 MsgBox ("C'est le joueur 3 qui remporte la première sélection" ), vbInformation, Range("A3" )
 Range("D4" ).Value = Range("B6" ): j3 = 1
 End If

 suite:

 MsgBox "Vous devez trouver le prix de " & objet2, , "avec les 2 autres joueurs"

 On Error Resume Next
 If j1 = 1 Then
 debut4:

joueur2 = InputBox("Donnez une estimation", Range("B5" ))

If joueur2 = 0 Then GoTo debut4

 debut5:

joueur3 = InputBox("Donnez une estimation", Range("B6" ))

If joueur3 = 0 Then GoTo debut5

b = Abs(joueur2 - prix2)

c = Abs(joueur3 - prix2)

If b = 0 Then MsgBox "Bravo! " & Range("B5" ), , "tu as trouvé le juste Prix=" & prix2: Range("D4" ).Value = Range("B5" ): GoTo fin

If c = 0 Then MsgBox "Bravo! " & Range("B6" ), , "tu as trouvé le juste Prix=" & prix2: Range("D4" ).Value = Range("B6" ): GoTo fin

If b < c Then

MsgBox ("C'est le joueur 2 qui remporte la première sélection" ), vbInformation, Range("A2" )

Range("D5" ).Value = Range("B5" )

Else

MsgBox ("C'est le joueur 3 qui remporte la première sélection" ), vbInformation, Range("A3" )

Range("D5" ).Value = Range("B6" )

End If

 End If

 If j2 = 1 Then
 debut6:

joueur1 = InputBox("Donnez une estimation", Range("B4" ))

If joueur1 = 0 Then GoTo debut6

 debut7:

joueur3 = InputBox("Donnez une estimation", Range("B6" ))

If joueur3 = 0 Then GoTo debut7

a = Abs(joueur2 - prix2)

c = Abs(joueur3 - prix2)

If a = 0 Then MsgBox "Bravo! " & Range("B4" ), , "tu as trouvé le juste Prix=" & prix2: Range("D4" ).Value = Range("B4" ): GoTo fin

If c = 0 Then MsgBox "Bravo! " & Range("B6" ), , "tu as trouvé le juste Prix=" & prix2: Range("D4" ).Value = Range("B6" ): GoTo fin

If a < c Then

MsgBox ("C'est le joueur 1 qui remporte la première sélection" ), vbInformation, Range("A2" )

Range("D5" ).Value = Range("B5" )

Else

MsgBox ("C'est le joueur 3 qui remporte la première sélection" ), vbInformation, Range("A3" )

Range("D5" ).Value = Range("B6" )

End If

 End If

 If j3 = 1 Then
 debut8:

joueur1 = InputBox("Donnez une estimation", Range("B4" ))

If joueur1 = 0 Then GoTo debut8

 debut9:

joueur2 = InputBox("Donnez une estimation", Range("B5" ))

If joueur2 = 0 Then GoTo debut9

a = Abs(joueur1 - prix2)

b = Abs(joueur2 - prix2)

If a = 0 Then MsgBox "Bravo! " & Range("B4" ), , "tu as trouvé le juste Prix=" & prix2: Range("D4" ).Value = Range("B4" ): GoTo fin

If b = 0 Then MsgBox "Bravo! " & Range("B5" ), , "tu as trouvé le juste Prix=" & prix2: Range("D4" ).Value = Range("B5" ): GoTo fin

If a < b Then

MsgBox ("C'est le joueur 1 qui remporte la première sélection" ), vbInformation, Range("A2" )

Range("D5" ).Value = Range("B4" )

Else

MsgBox ("C'est le joueur 2 qui remporte la première sélection" ), vbInformation, Range("A3" )

Range("D5" ).Value = Range("B5" )

End If
 fin:
 End If

 MsgBox objet1 & "=" & prix1 & Chr$(13) & objet2 & "=" & prix2, vbInformation
 End Sub

 :hello:

(Publicité)
willyplaisir
Expert Excel Habitué (de 5 000 à 9 999 messages postés)
  1. Posté le 17/05/2013 à 16:41:05  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
rebonjour,
 voici les modifs apportées à ton programme:


 Sub différence()
 Dim a As Double, b As Double, c As Double, joueur1 As Double, joueur2 As Double, joueur3 As Double

 'participation de willy le 17 mai 2013
 '-----------------------------​-----------------
 'mettre tes données en debut de programme
 objet1 = "paire de lunette Ray-Ban"
 prix1 = 120

 objet2 = "Vélo"
 prix2 = 350
 '-----------------------------​------------------

 MsgBox "Vous devez trouver le prix " & objet1, , "L'objectif est de trouver la meilleure estimation d'un objet "
 Range("D4:D5" ).ClearContents

 On Error Resume Next
 debut1:
 joueur1 = InputBox("Donnez une estimation", Range("B4" ))
 If joueur1 = 0 Then GoTo debut1

 debut2:
 joueur2 = InputBox("Donnez une estimation", Range("B5" ))
 If joueur2 = 0 Then GoTo debut2

 debut3:
 joueur3 = InputBox("Donnez une estimation", Range("B6" ))
 If joueur3 = 0 Then GoTo debut3

 a = Abs(joueur1 - prix1)
 b = Abs(joueur2 - prix1)
 c = Abs(joueur3 - prix1)

 If a = 0 Then MsgBox "Bravo! " & Range("B4" ), , " tu as trouvé le juste Prix=" & prix1: Range("D4" ).Value = Range("B4" ): j1 = 1: GoTo suite
 If b = 0 Then MsgBox "Bravo! " & Range("B5" ), , "tu as trouvé le juste Prix=" & prix1: Range("D4" ).Value = Range("B5" ): j2 = 1: GoTo suite
 If c = 0 Then MsgBox "Bravo! " & Range("B6" ), , "tu as trouvé le juste Prix=" & prix1: Range("D4" ).Value = Range("B6" ): j3 = 1: GoTo suite

 If a < b And a < c Then
 MsgBox ("C'est le joueur 1 qui remporte la première sélection" ), vbInformation, Range("A1" )
 Range("D4" ).Value = Range("B4" ): j1 = 1
 End If

 If b < a And b < c Then
 MsgBox ("C'est le joueur 2 qui remporte la première selection" ), vbInformation, Range("A2" )
 Range("D4" ).Value = Range("B5" ): j2 = 1
 End If

 If c < a And c < b Then
 MsgBox ("C'est le joueur 3 qui remporte la première sélection" ), vbInformation, Range("A3" )
 Range("D4" ).Value = Range("B6" ): j3 = 1
 End If

 suite:

 MsgBox "Vous devez trouver le prix de " & objet2, , "avec les 2 autres joueurs"

 On Error Resume Next
 If j1 = 1 Then
 debut4:

joueur2 = InputBox("Donnez une estimation", Range("B5" ))

If joueur2 = 0 Then GoTo debut4

 debut5:

joueur3 = InputBox("Donnez une estimation", Range("B6" ))

If joueur3 = 0 Then GoTo debut5

b = Abs(joueur2 - prix2)

c = Abs(joueur3 - prix2)

If b = 0 Then MsgBox "Bravo! " & Range("B5" ), , "tu as trouvé le juste Prix=" & prix2: Range("D5" ).Value = Range("B5" ): GoTo fin

If c = 0 Then MsgBox "Bravo! " & Range("B6" ), , "tu as trouvé le juste Prix=" & prix2: Range("D5" ).Value = Range("B6" ): GoTo fin

If b < c Then

MsgBox ("C'est le joueur 2 qui remporte la première sélection" ), vbInformation, Range("A2" )

Range("D5" ).Value = Range("B5" )

Else

MsgBox ("C'est le joueur 3 qui remporte la première sélection" ), vbInformation, Range("A3" )

Range("D5" ).Value = Range("B6" )

End If

 End If

 If j2 = 1 Then
 debut6:

joueur1 = InputBox("Donnez une estimation", Range("B4" ))

If joueur1 = 0 Then GoTo debut6

 debut7:

joueur3 = InputBox("Donnez une estimation", Range("B6" ))

If joueur3 = 0 Then GoTo debut7

a = Abs(joueur1 - prix2)

c = Abs(joueur3 - prix2)

If a = 0 Then MsgBox "Bravo! " & Range("B4" ), , "tu as trouvé le juste Prix=" & prix2: Range("D5" ).Value = Range("B4" ): GoTo fin

If c = 0 Then MsgBox "Bravo! " & Range("B6" ), , "tu as trouvé le juste Prix=" & prix2: Range("D5" ).Value = Range("B6" ): GoTo fin

If a < c Then

MsgBox ("C'est le joueur 1 qui remporte la première sélection" ), vbInformation, Range("A2" )

Range("D5" ).Value = Range("B4" )

Else

MsgBox ("C'est le joueur 3 qui remporte la première sélection" ), vbInformation, Range("A3" )

Range("D5" ).Value = Range("B6" )

End If

 End If

 If j3 = 1 Then
 debut8:

joueur1 = InputBox("Donnez une estimation", Range("B4" ))

If joueur1 = 0 Then GoTo debut8

 debut9:

joueur2 = InputBox("Donnez une estimation", Range("B5" ))

If joueur2 = 0 Then GoTo debut9

a = Abs(joueur1 - prix2)

b = Abs(joueur2 - prix2)

If a = 0 Then MsgBox "Bravo! " & Range("B4" ), , "tu as trouvé le juste Prix=" & prix2: Range("D5" ).Value = Range("B4" ): GoTo fin

If b = 0 Then MsgBox "Bravo! " & Range("B5" ), , "tu as trouvé le juste Prix=" & prix2: Range("D5" ).Value = Range("B5" ): GoTo fin

If a < b Then

MsgBox ("C'est le joueur 1 qui remporte la première sélection" ), vbInformation, Range("A2" )

Range("D5" ).Value = Range("B4" )

Else

MsgBox ("C'est le joueur 2 qui remporte la première sélection" ), vbInformation, Range("A3" )

Range("D5" ).Value = Range("B5" )

End If
 fin:
 End If

 MsgBox objet1 & "=" & prix1 & Chr$(13) & objet2 & "=" & prix2, vbInformation, "Pour Information des prix"
 End Sub

 voici le fichier à tester
 http://cjoint.com/?CErrOxHkPN1

 :hello:

martinedumes
  1. Posté le 17/05/2013 à 17:05:22  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
Bonsoir,

 Merci beaucoup pour votre aide, le programme marche parfaitement dans ma feuille Excel !
 Bon courage pour la suite,

 Martine  :jap:

willyplaisir
Expert Excel Habitué (de 5 000 à 9 999 messages postés)
  1. Posté le 17/05/2013 à 19:20:32  
  1. answer
  1. Prévenir les modérateurs en cas d'abus
 
bonsoir Martine,

 a toi de comprendre ce que j'ai fait...j'espère que tu auras une bonne Note à ton devoir d'informatique.
 as tu appris à construire un organigramme? la logique avec les conditions?
 un minimum de connaissance en maths est exigé si tu veux continuer en informatique pour créer tes programmes.

 http://fr.wikipedia.org/wiki/O [...] grammation

 ajoute(Résolu) au titre du 1er Post avec l’éditeur.
 Bon courage à toi
 willy  :jap:

(Publicité)
 Page :
1

Aller à :
 

Sujets relatifs
programmation caisse sharp XE-A113 programmation en C
aide à la programmation Programmation Client/Serveur (Serveur vente de place de concert)
Concours de programmation - Legends of Code Concours de programmation CODEOF DUTY 2
optimiser des boucle multiple (temps d'exécution très long) programmation c++ et sdl
La grande Surprise de 2012 / Des codes allopass Vous vous posez des questions sur la programmation ou
Plus de sujets relatifs à : V.B.A , programmation d'une grande boucle.