SOS VBA Besoin d'aide pour un programme

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : SOS VBA Besoin d'aide pour un programme

kenza91

Salut à tous!

Voilà je dois faire un programme qui colorie en orange 20 premières lignes et colonnes d'une feuille excel de façon aléatoire sauf que la coloration du carré 20*20 s'arrête dès qu'une cellule est choisie deux fois. le programme indiquera sur la première cellule(1,1), le nombre de cellules coloriées.

Un virus est placé au hasard. Dès qu'il atteint une couleur, elle disparaît.
Ne fait rien sur une case blanche, peut se déplacer haut/bas, droite/gauche.
Si couleur à côté (voisinage immédiat), se dirige vers celle-ci.

Je suis parvenue à faire la première partie mais je bloque sur la partie "virus"
Si quelqu'un pouvait m'aider en me proposant un code ça serait vraiment gentil ! :ange:

Publicité

tarteflambee

Salut [:cerveau dr]

Tu peux déjà poster la première partie [:doc_prodigy]

Spoiler :

Sub aaa()

Dim nb_rows_cols As Integer, nb_cells As Integer
Dim alea1 As Integer, alea2 As Integer

nb_rows_cols = 20
nb_cells = 0

With ThisWorkbook.Worksheets("Feuil1" )
.Range(.Cells(1, 1), .Cells(nb_rows_cols, nb_rows_cols)).Clear
Do
Randomize
alea1 = CInt(Int((20 * Rnd()) + 1))
alea2 = CInt(Int((20 * Rnd()) + 1))
If .Cells(alea1, alea2).Interior.ColorIndex <> 45 Then
.Cells(alea1, alea2).Interior.ColorIndex = 45
nb_cells = nb_cells + 1
Else
Exit Do
End If
Loop
.Cells(1, 1).value = nb_cells
End With

End Sub

J'ai un peu de mal à comprendre la deuxième partie, ce n'est pas assez détaillé. [:quardelitre dei]
Il y a un seul virus ? Il peut se déplacer autant de fois qu'il veut ? Il se déplace jusqu'à disparaitre ? Il va aléatoirement à gauche/droite/haut/bas?
Voisinage immédiat c'est une cellule de distance ? En diagonale c'est voisinage immédiat ?
Quel est le but en fait ? [:quardelitre] Savoir le chemin qu'il a parcouru ? En combien de déplacement il disparait ?

Message cité 1 fois
Message édité par tarteflambee le 22-03-2013 à 22:33:59

Marc L

Bonjour Kenza91 ! J'ai bien un code tout prêt (ton exercice est un classique si j'oserais) mais afin de ne pas déroger
aux règles de ce forum, oui on aimerait bien voir ton code et tes difficultés exposées …

Message cité 1 fois

kenza91

Marc L a écrit :

Bonjour Marc L
Oui je comprends . Alors voilà la partie que j'ai réussi à faire, elle est composée de deux procédures:

Sub ppalebis()

Dim n As Integer
n = InputBox("entrez la taille de la forêt" )
Call coloriagebis(n)

End Sub

Sub coloriagebis(ni As Integer)

Dim i As Integer
Dim j As Integer
Dim compteur As Integer
Dim test As Boolean

compteur = 0
test = False
Do
Randomize
i = Int(ni * Rnd + 1)
j = Int(ni * Rnd + 1)

If Cells(i, j).Value <> "A" Then
Cells(i, j).Value = "A"
Cells(i, j).Select
Selection.Interior.ColorIndex = 50
compteur = compteur + 1
Else
test = True
End If

Loop Until test = True

End Sub

Pour la partie virus mangeur j'ai essayé ce code mais ça ne donne pas grand chose :

Sub recherche_couleur()
Dim i As Integer
Dim ma_plage As Range
ma_plage.Cells(Int(Rnd * 24) + 1, Int(Rnd * 16) + 1).Select 'pour sélectionner au hasard une case dans mon tableur 16*24

Set ma_plage = Range(ActiveCell.Offset(-1, -1), ActiveCell.Offset(1, 1))

For i = 1 To 9

If i = 5 Then i = 6

If ma_plage.Cells(i).Interior.ColorIndex = RGB(255, 0, 0) Then

ma_plage.Cells(i).Select
ma_plage.Cells(i).Interior.ColorIndex = RGB(0, 102, 0)

Exit Sub
End If
End If
Next i

End Sub

Voilà j'espère que c'est suffisant pour que tu puisses m'orienter un peu vers la bonne réponse.
Il faut savoir que je suis ne suis pas du tout experte en VBA, ce n'est pas du tout quelque chose que je maîtrise vu que j'ai une formation plutôt scientifique et les cours qui nous sont donnés ne sont pas bien expliqués du tout.
Ils nous donnent des choses à faire comme celles-ci sans que nous ayons des connaissances suffisantes derrière. Donc j'ai essayé de faire de mon mieux et je suis venue sur ce forum afin qu'une âme charitable, comme toi cher Marc L, puisse me sortir de cette galère

kenza91

tarteflambee a écrit :

Salut [:cerveau dr]

Tu peux déjà poster la première partie [:doc_prodigy]

Spoiler :

Bonjour!

D'abord merci pour ta réponse!

En faite il y a deux options concernant ce virus mangeur :

Option 1.
On considère que le virus est STUPIDE: il se propage de façon aléatoire dans la forêt
générée (c'est-à-dire les couleurs générées). Au départ, le virus possède une quantité d’énergie maximale ET à chaque fois qu'il
se déplace, il dépense une part de cette énergie EU. Lorsque le virus consomme toute son énergie, il meurt.
Si le virus mange un arbre, son énergie passe au maximum ET. Pour simplifier, on considère que chaque déplacement du virus sur une cellule du tableau coute une unité d’énergie EU, et ET=k EU. K est une valeur arbitraire.

Option 2.
virus INTELLIGENT: Il est capable de percevoir son environnement proche,
à savoir les 8 cellules voisines :

Voisin Voisin Voisin
Voisin Virus Voisin
Voisin Voisin Voisin

Si un au moins un des voisins est un arbre alors le virus se déplace de façon arbitraire sur un des

arbres et le mange

Si aucun des voisins n’est un arbre, le virus se déplace aléatoirement à partir de sa position

Voilà j'espère que c'est plus clair maintenant !

Marc L

Bonsoir. Après une journée de "travail" (et oui même un dimanche !), levé depuis 5h et rentrant à peine (Ok fin de my life !),
je n'ai guère le courage de t'orienter didactiquement tel un professeur …

Ne doutant pas de mon état de demain, je fais donc exception à la règle en livrant mon code optimisé
mais toutefois ne tenant pas compte de ta réponse aux questions de tarteflambee,
il faudra donc peut-être t'en inspirer afin de l'adapter à ton programme,
car là c'est à ma sauce, ne correspondant pas forcément aux cours dispensés …

Précisions sur ma procédure (ColorBug) :

- à pleine vitesse, pas le temps de voir grand-chose !
J'ai donc inséré une temporisation afin d'observer le comportement erratique du virus.

Pour revenir à pleine vitesse, il suffit de mettre en commentaire la ligne n°41
et de réactiver la pause de la ligne n°29 juste pour voir le nombre de cases coloriées …

- Le virus est un poil "évolué", il ne revient pas sur ses trois derniers pas (tableau AD).

Code :

Function Aleat(ByVal Rg As Range) As Range
Set Aleat = Rg(Fix(Rg.Count * Rnd) + 1)
End Function
Sub Pause(Optional P = 0.04)
D = Timer: F = D + P
While Timer < F
If Timer < D Then F = F - 86400: D = 0
Wend
DoEvents
End Sub
Sub ColorBug()
Dim AD(2)
Const CI = 44, LC = 20
Set Rg = [A1].Resize(LC, LC)
Rg.Clear: Randomize
Do
With Aleat(Rg).Interior
If .ColorIndex = CI Then Exit Do Else .ColorIndex = CI: [A1] = [A1] + 1
End With
Loop
' Pause 0.5
Set Rs = Aleat(Rg)
Do
With Rs
.Select
AD(2) = AD(1): AD(1) = AD(0): AD(0) = .Address
If .Interior.ColorIndex = CI Then
.Interior.ColorIndex = xlNone: [A1] = [A1] - 1: If [A1] < 1 Then Exit Do
End If
Pause
C = .Column > 1
R = .Row > 1
Set Rc = .Offset(R, C).Resize(2 - (R And .Row < LC), 2 - (C And .Column < LC))
End With
Set Rs = Nothing
For Each Cel In Rc
If Cel.Interior.ColorIndex = CI Then Set Rs = Cel: Exit For
Next
If Rs Is Nothing Then
Do
Set Rs = Aleat(Rc)
For Each Cel In AD
NO = Rs.Address = Cel: If NO Then Exit For
Next
Loop While NO
End If
Loop
End Sub

Message cité 1 fois

tarteflambee

Je propose une approche POO pour ma part.
A toi de modifier pour avoir un virus intelligent. :bounce:
Aussi mon virus stupide se cogne contre les bords.

main sub

Code :

Public Const nb_rows_cols As Integer = 20
Sub aaa()
Dim nb_cells As Integer
Dim alea1 As Integer, alea2 As Integer
Dim oVirus As virus
nb_cells = 0
With ThisWorkbook.Worksheets(1)
.Range(.Cells(1, 1), .Cells(nb_rows_cols, nb_rows_cols)).Clear
Do
Randomize
alea1 = CInt(Int((nb_rows_cols * Rnd()) + 1))
alea2 = CInt(Int((nb_rows_cols * Rnd()) + 1))
If .Cells(alea1, alea2).Interior.ColorIndex <> 50 Then
.Cells(alea1, alea2).Interior.ColorIndex = 50
nb_cells = nb_cells + 1
Else
Exit Do
End If
Loop
.Cells(1, 1).value = nb_cells
Set oVirus = New virus
Call oVirus.initialize(50, True)
Do
oVirus.Move
.Cells(1, nb_rows_cols + 1).value = "Life: " & oVirus.Get_life
Loop Until oVirus.Get_life <= 0
End With
set oVirus=Nothing
End Sub

module de classe "virus"

Code :

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const EU As Integer = 1
Private ET As Integer, life As Integer
Private IsRetarded As Boolean
Private x As Integer
Private y As Integer
Property Get Get_life() As Integer
Get_life = life
End Property
Public Sub initialize(ByVal iET As Integer, ByVal bIsRetarded As Boolean)
ET = iET
life = ET
IsRetarded = bIsRetarded
'start position
Randomize
x = CInt(Int((nb_rows_cols * Rnd()) + 1))
y = CInt(Int((nb_rows_cols * Rnd()) + 1))
Call get_in_cell(x, y)
End Sub
Private Sub get_in_cell(ByVal x As Integer, y As Integer)
If ThisWorkbook.Worksheets(1).Cells(x, y).Interior.ColorIndex = 50 Then life = ET 'eat tree get full life
ThisWorkbook.Worksheets(1).Cells(x, y).Interior.Color = vbBlack
End Sub
Private Sub leave_cell(ByVal x As Integer, y As Integer)
ThisWorkbook.Worksheets(1).Cells(x, y).Interior.Color = vbWhite
End Sub
Public Sub Move()
life = life - EU
Call leave_cell(x, y)
Randomize
Select Case CInt(Int((4 * Rnd()) + 1))
Case 1 'right
y = WorksheetFunction.Min(y + 1, nb_rows_cols)
Case 2 'left
y = WorksheetFunction.Max(y - 1, 1)
Case 3 'up
x = WorksheetFunction.Max(x - 1, 1)
Case 4 'down
x = WorksheetFunction.Min(x + 1, nb_rows_cols)
End Select
Call get_in_cell(x, y)
Sleep (100)
DoEvents
End Sub

Message cité 1 fois

kenza91

Marc L a écrit :

Code :

Function Aleat(ByVal Rg As Range) As Range
Set Aleat = Rg(Fix(Rg.Count * Rnd) + 1)
End Function
Sub Pause(Optional P = 0.04)
D = Timer: F = D + P
While Timer < F
If Timer < D Then F = F - 86400: D = 0
Wend
DoEvents
End Sub
Sub ColorBug()
Dim AD(2)
Const CI = 44, LC = 20
Set Rg = [A1].Resize(LC, LC)
Rg.Clear: Randomize
Do
With Aleat(Rg).Interior
If .ColorIndex = CI Then Exit Do Else .ColorIndex = CI: [A1] = [A1] + 1
End With
Loop
' Pause 0.5
Set Rs = Aleat(Rg)
Do
With Rs
.Select
AD(2) = AD(1): AD(1) = AD(0): AD(0) = .Address
If .Interior.ColorIndex = CI Then
.Interior.ColorIndex = xlNone: [A1] = [A1] - 1: If [A1] < 1 Then Exit Do
End If
Pause
C = .Column > 1
R = .Row > 1
Set Rc = .Offset(R, C).Resize(2 - (R And .Row < LC), 2 - (C And .Column < LC))
End With
Set Rs = Nothing
For Each Cel In Rc
If Cel.Interior.ColorIndex = CI Then Set Rs = Cel: Exit For
Next
If Rs Is Nothing Then
Do
Set Rs = Aleat(Rc)
For Each Cel In AD
NO = Rs.Address = Cel: If NO Then Exit For
Next
Loop While NO
End If
Loop
End Sub

Bonsoir

Merci d'avoir pris la peine de m'aider même après ta grosse journée c'est vraiment très gentil de ta part ! J'ai testé ton code et il marche très bien. Tu as l'air d'être un expert confirmé en VBA et ça se voit à ton code qui est extrêmement compliqué pour moi ^^
Donc je vais essayer de m'en inspirer comme tu as dit parce que ce n'est pas du tout de mon niveau.

Merci encore!

Message cité 1 fois

kenza91

tarteflambee a écrit :

Je propose une approche POO pour ma part.
A toi de modifier pour avoir un virus intelligent. :bounce:
Aussi mon virus stupide se cogne contre les bords.

main sub

Code :

Public Const nb_rows_cols As Integer = 20
Sub aaa()
Dim nb_cells As Integer
Dim alea1 As Integer, alea2 As Integer
Dim oVirus As virus
nb_cells = 0
With ThisWorkbook.Worksheets(1)
.Range(.Cells(1, 1), .Cells(nb_rows_cols, nb_rows_cols)).Clear
Do
Randomize
alea1 = CInt(Int((nb_rows_cols * Rnd()) + 1))
alea2 = CInt(Int((nb_rows_cols * Rnd()) + 1))
If .Cells(alea1, alea2).Interior.ColorIndex <> 50 Then
.Cells(alea1, alea2).Interior.ColorIndex = 50
nb_cells = nb_cells + 1
Else
Exit Do
End If
Loop
.Cells(1, 1).value = nb_cells
Set oVirus = New virus
Call oVirus.initialize(50, True)
Do
oVirus.Move
.Cells(1, nb_rows_cols + 1).value = "Life: " & oVirus.Get_life
Loop Until oVirus.Get_life <= 0
End With
set oVirus=Nothing
End Sub

module de classe "virus"

Code :

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const EU As Integer = 1
Private ET As Integer, life As Integer
Private IsRetarded As Boolean
Private x As Integer
Private y As Integer
Property Get Get_life() As Integer
Get_life = life
End Property
Public Sub initialize(ByVal iET As Integer, ByVal bIsRetarded As Boolean)
ET = iET
life = ET
IsRetarded = bIsRetarded
'start position
Randomize
x = CInt(Int((nb_rows_cols * Rnd()) + 1))
y = CInt(Int((nb_rows_cols * Rnd()) + 1))
Call get_in_cell(x, y)
End Sub
Private Sub get_in_cell(ByVal x As Integer, y As Integer)
If ThisWorkbook.Worksheets(1).Cells(x, y).Interior.ColorIndex = 50 Then life = ET 'eat tree get full life
ThisWorkbook.Worksheets(1).Cells(x, y).Interior.Color = vbBlack
End Sub
Private Sub leave_cell(ByVal x As Integer, y As Integer)
ThisWorkbook.Worksheets(1).Cells(x, y).Interior.Color = vbWhite
End Sub
Public Sub Move()
life = life - EU
Call leave_cell(x, y)
Randomize
Select Case CInt(Int((4 * Rnd()) + 1))
Case 1 'right
y = WorksheetFunction.Min(y + 1, nb_rows_cols)
Case 2 'left
y = WorksheetFunction.Max(y - 1, 1)
Case 3 'up
x = WorksheetFunction.Max(x - 1, 1)
Case 4 'down
x = WorksheetFunction.Min(x + 1, nb_rows_cols)
End Select
Call get_in_cell(x, y)
Sleep (100)
DoEvents
End Sub

Bonsoir !

merci beaucoup pour ce code. J'ai essayé de le tester mais il y a toujours une erreur de compilation au niveau de la ligne n°1 de la main sub .
Tu penses que c'est dû à quoi parce que je ne vois pas où est l'erreur ? :heink:

Marc L

@tarteflambee : sympa ton code mais un peu compliqué pour une débutante en VBA …

kenza91 a écrit :

[…] Tu as l'air d'être un expert confirmé en VBA et ça se voit à ton code qui est extrêmement compliqué pour moi ^^
Donc je vais essayer de m'en inspirer comme tu as dit parce que ce n'est pas du tout de mon niveau.

Bonsoir ! Disons que je me débrouille un peu !

J’essaye de directement travailler avec les objets, le code en est plus concis et plus efficace …
Pour la compréhension, n'hésites pas à poser des questions en indiquant le n° de la ligne du code.

Je l'ai modifié afin de correspondre aux précisions données suite aux questions de tarteflambee
mais comme c'est ton devoir, ce serait bien de te faire progresser avant de le dévoiler …

ps: mieux vaut t'adresser à quelqu'un en citant son nom au lieu de re-poster l'intégralité d'un message
surtout avec un code long, ou sinon coupe-le …

Publicité

tarteflambee

Je pense que tu as mis le code dans la worksheet.

Crée un module (Insert>Module) pour la première partie.
Et un module de classe (Insert>Class module) nommé "virus" pour la deuxième partie.

(Au pire tu vois que c'est une constante que tu pourrais déclarer dans chaque partie)

Message cité 1 fois
Message édité par tarteflambee le 26-03-2013 à 06:30:28

kenza91

Bonsoir !

@Marc L Merci pour le tuyau tu as dû comprendre que je n'étais pas une habituée des forums ^^ Et pour ton code il parfait, je comprends un peu le principe mais il y a beaucoup de fonctions que je connais pas donc je ne peux pas l'utiliser malheureusement

tarteflambee a écrit :

Je pense que tu as mis le code dans la worksheet.

Crée un module (Insert>Module) pour la première partie.
Et un module de classe (Insert>Class module) nommé "virus" pour la deuxième partie (...)

J'ai fait ce que tu m'as dit mais ça ne marche toujours pas. Pour la sub aaa il y a un problème au niveau de la ligne n°7 :
Dim oVirus as virus ?? ma question va peut être te paraître débile mais virus c'est sensé être un type comme Integer ou String ? :heink:

Sinon peut-être que c'est trop demander mais j'ai réfléchis à une méthode assez simple mais que je n'arrive pas trop à traduire en algorithme ça serait:

Une grande boucle de 200 sauts

A l 'intérieur de cette boucle générer une direction aléatoire dans la limite de la plage
Tester si la couleur est bonne
Si c'est le cas changer la couleur
Si ca n'est pas le cas
Démarrer une sous-boucle bouclant sur les cellules adjacentes selon mes critères
changer la couleur si la couleur est trouvée
fin de sous-boucle
fin de grande boucle

Je pense que c'est l'approche la plus simple pour mon cas :ange:

Message cité 1 fois

tarteflambee

oui virus c'est un objet que l'on crée via le class module. Il faut donc que le class module s'appelle virus pour que ce type personnalisé puisse être reconnu.

Marc L

kenza91 a écrit :

Une grande boucle de 200 sauts

A l 'intérieur de cette boucle générer une direction aléatoire dans la limite de la plage
Tester si la couleur est bonne
Si c'est le cas changer la couleur
Si ca n'est pas le cas
Démarrer une sous-boucle bouclant sur les cellules adjacentes selon mes critères
changer la couleur si la couleur est trouvée
fin de sous-boucle
fin de grande boucle

J'ai du mal avec ce scénario par rapport aux précédentes précisions … :heink:

Mais bon, avance déjà dans ton code puis, en cas de souci, soumet-le-nous en précisant la difficulté rencontrée.

Note qu'avec seulement 200 sauts, statistiquement (en fait j'ai pu le voir avec ma procédure en attente),
souvent des cases coloriées resteront …

Marc L

Comme j'ai vu exactement le même énoncé sur d'autres forums et des solutions postées, voici donc ma version finale :

Code :

Function Aleat(ByVal Rg) As Range
If TypeName(Rg) = "Range" Then Set Aleat = Rg(Fix(Rg.Count * Rnd) + 1) _
Else Set Aleat = Range(Rg(Fix(UBound(Rg) * Rnd) + 1))
End Function
Sub ColoriagePuisRecherche()
Const CI = 44, LC = 16
Set Rg = [B2].Resize(LC, LC)
K = Rg.Count
EU = K
M = K
Union([A1:F1], Rg).Clear: Randomize
Do
With Aleat(Rg).Interior
If .ColorIndex = CI Then Exit Do Else .ColorIndex = CI: N = N + 1
End With
Loop
[A1] = N
Set Rs = Aleat(Rg)
Do
With Rs
.Select: EU = EU - 1
If .Interior.ColorIndex = CI Then
.Interior.ColorIndex = xlNone: N = N - 1
If EU < M Then M = EU
If N = 0 Then [C1] = "EU : " & EU: [E1] = "EU mini : " & M: Exit Do
EU = K
ElseIf EU = 0 Then
.Value = " MORT !": [C1] = "Reste : " & N: Exit Do
End If
Set Rc = Application.Intersect(.Offset(-1, -1).Resize(3, 3), Rg)
A = .Address
End With
CA = ""
For Each Cel In Rc
If Cel.Interior.ColorIndex = CI Then CA = CA & " " & Cel.Address
Next
Do
If CA = "" Then Set Rs = Aleat(Rc) Else Set Rs = Aleat(Split(CA))
Loop While Rs.Address = A
Loop
End Sub

Message cité 1 fois

kenza91

Marc L a écrit :

Comme j'ai vu exactement le même énoncé sur d'autres forums et des solutions postées, voici donc ma version finale : ....

Merci beaucoup !!

FORUM HardWare.fr

Programmation

VB/VBA/VBS

SOS VBA Besoin d'aide pour un programme

Sujets relatifs
Printf qui change le résultat d'un programme ??	Lancer invite de commande en VBA
Ecritude dans un fichier.bat à partir de VBA	Programme débutant
problème programmation VBA	Re-programmer un logiciel ?
Pb pour fermer programme avec touche clavier. (VB)	[C/C++]Programme cube led, besoin d'aide pour comprendre
Plus de sujets relatifs à : SOS VBA Besoin d'aide pour un programme

Page générée en 0.142 secondes