SOS VBA Besoin d'aide pour un programme

SOS VBA Besoin d'aide pour un programme - VB/VBA/VBS - Programmation

Marsh Posté le 22-03-2013 à 21:16:26    

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

Reply

Marsh Posté le 22-03-2013 à 21:16:26   

Reply

Marsh Posté le 22-03-2013 à 22:31:16    

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 ? :o  
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
Reply

Marsh Posté le 23-03-2013 à 09:07:23    

 
           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
Reply

Marsh Posté le 24-03-2013 à 19:09:36    

Marc L a écrit :

 
           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 …
 


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

Reply

Marsh Posté le 24-03-2013 à 19:20:39    

tarteflambee a écrit :

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 ? :o  
Quel est le but en fait ?  [:quardelitre]  Savoir le chemin qu'il a parcouru ? En combien de déplacement il disparait ?


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

Reply

Marsh Posté le 24-03-2013 à 23:05:34    

 
           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 :
  1. Function Aleat(ByVal Rg As Range) As Range
  2.      Set Aleat = Rg(Fix(Rg.Count * Rnd) + 1)
  3. End Function
  6. Sub Pause(Optional P = 0.04)
  7.       D = Timer:   F = D + P
  9.     While Timer < F
  10.        If Timer < D Then F = F - 86400: D = 0
  11.     Wend
  13.     DoEvents
  14. End Sub
  17. Sub ColorBug()
  18.     Dim AD(2)
  19.     Const CI = 44, LC = 20
  20.       Set Rg = [A1].Resize(LC, LC)
  21.     Rg.Clear:  Randomize
  23.     Do
  24.         With Aleat(Rg).Interior
  25.             If .ColorIndex = CI Then Exit Do Else .ColorIndex = CI: [A1] = [A1] + 1
  26.         End With
  27.     Loop
  29. '    Pause 0.5
  30.     Set Rs = Aleat(Rg)
  32.     Do
  33.         With Rs
  34.             .Select
  35.             AD(2) = AD(1):  AD(1) = AD(0):  AD(0) = .Address
  37.             If .Interior.ColorIndex = CI Then
  38.                .Interior.ColorIndex = xlNone:  [A1] = [A1] - 1:  If [A1] < 1 Then Exit Do
  39.             End If
  41.             Pause
  42.                  C = .Column > 1
  43.                  R = .Row > 1
  44.             Set Rc = .Offset(R, C).Resize(2 - (R And .Row < LC), 2 - (C And .Column < LC))
  45.         End With
  47.         Set Rs = Nothing
  49.         For Each Cel In Rc
  50.             If Cel.Interior.ColorIndex = CI Then Set Rs = Cel: Exit For
  51.         Next
  53.         If Rs Is Nothing Then
  54.             Do
  55.                 Set Rs = Aleat(Rc)
  57.                 For Each Cel In AD
  58.                     NO = Rs.Address = Cel:  If NO Then Exit For
  59.                 Next
  60.             Loop While NO
  61.         End If
  62.     Loop
  63. End Sub


Message cité 1 fois
Reply

Marsh Posté le 25-03-2013 à 21:33:23    

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 :
  1. Public Const nb_rows_cols As Integer = 20
  3. Sub aaa()
  5. Dim nb_cells As Integer
  6. Dim alea1 As Integer, alea2 As Integer
  7. Dim oVirus As virus
  9. nb_cells = 0
  10. With ThisWorkbook.Worksheets(1)
  11.     .Range(.Cells(1, 1), .Cells(nb_rows_cols, nb_rows_cols)).Clear
  12.     Do
  13.         Randomize
  14.         alea1 = CInt(Int((nb_rows_cols * Rnd()) + 1))
  15.         alea2 = CInt(Int((nb_rows_cols * Rnd()) + 1))
  16.         If .Cells(alea1, alea2).Interior.ColorIndex <> 50 Then
  17.             .Cells(alea1, alea2).Interior.ColorIndex = 50
  18.             nb_cells = nb_cells + 1
  19.         Else
  20.             Exit Do
  21.         End If
  22.     Loop
  23.     .Cells(1, 1).value = nb_cells
  24.     Set oVirus = New virus
  25.     Call oVirus.initialize(50, True)
  26.     Do
  27.         oVirus.Move
  28.         .Cells(1, nb_rows_cols + 1).value = "Life: " & oVirus.Get_life
  29.     Loop Until oVirus.Get_life <= 0
  30. End With
  31. set oVirus=Nothing
  32. End Sub


module de classe "virus"

Code :
  1. Option Explicit
  3. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  5. Private Const EU As Integer = 1
  6. Private ET As Integer, life As Integer
  7. Private IsRetarded As Boolean
  8. Private x As Integer
  9. Private y As Integer
  10. Property Get Get_life() As Integer
  11.     Get_life = life
  12. End Property
  13. Public Sub initialize(ByVal iET As Integer, ByVal bIsRetarded As Boolean)
  14.     ET = iET
  15.     life = ET
  16.     IsRetarded = bIsRetarded
  17.     'start position
  18.     Randomize
  19.     x = CInt(Int((nb_rows_cols * Rnd()) + 1))
  20.     y = CInt(Int((nb_rows_cols * Rnd()) + 1))
  21.     Call get_in_cell(x, y)
  22. End Sub
  23. Private Sub get_in_cell(ByVal x As Integer, y As Integer)
  24.     If ThisWorkbook.Worksheets(1).Cells(x, y).Interior.ColorIndex = 50 Then life = ET 'eat tree get full life
  25.     ThisWorkbook.Worksheets(1).Cells(x, y).Interior.Color = vbBlack
  26. End Sub
  27. Private Sub leave_cell(ByVal x As Integer, y As Integer)
  28.     ThisWorkbook.Worksheets(1).Cells(x, y).Interior.Color = vbWhite
  29. End Sub
  30. Public Sub Move()
  31.     life = life - EU
  32.     Call leave_cell(x, y)
  33.     Randomize
  34.     Select Case CInt(Int((4 * Rnd()) + 1))
  35.         Case 1 'right
  36.             y = WorksheetFunction.Min(y + 1, nb_rows_cols)
  37.         Case 2 'left
  38.             y = WorksheetFunction.Max(y - 1, 1)
  39.         Case 3 'up
  40.             x = WorksheetFunction.Max(x - 1, 1)
  41.         Case 4 'down
  42.             x = WorksheetFunction.Min(x + 1, nb_rows_cols)
  43.     End Select
  44.     Call get_in_cell(x, y)
  45.     Sleep (100)
  46.     DoEvents
  47. End Sub

Message cité 1 fois
Reply

Marsh Posté le 26-03-2013 à 00:00:27    

Marc L a écrit :

 
           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 :
  1. Function Aleat(ByVal Rg As Range) As Range
  2.      Set Aleat = Rg(Fix(Rg.Count * Rnd) + 1)
  3. End Function
  6. Sub Pause(Optional P = 0.04)
  7.       D = Timer:   F = D + P
  9.     While Timer < F
  10.        If Timer < D Then F = F - 86400: D = 0
  11.     Wend
  13.     DoEvents
  14. End Sub
  17. Sub ColorBug()
  18.     Dim AD(2)
  19.     Const CI = 44, LC = 20
  20.       Set Rg = [A1].Resize(LC, LC)
  21.     Rg.Clear:  Randomize
  23.     Do
  24.         With Aleat(Rg).Interior
  25.             If .ColorIndex = CI Then Exit Do Else .ColorIndex = CI: [A1] = [A1] + 1
  26.         End With
  27.     Loop
  29. '    Pause 0.5
  30.     Set Rs = Aleat(Rg)
  32.     Do
  33.         With Rs
  34.             .Select
  35.             AD(2) = AD(1):  AD(1) = AD(0):  AD(0) = .Address
  37.             If .Interior.ColorIndex = CI Then
  38.                .Interior.ColorIndex = xlNone:  [A1] = [A1] - 1:  If [A1] < 1 Then Exit Do
  39.             End If
  41.             Pause
  42.                  C = .Column > 1
  43.                  R = .Row > 1
  44.             Set Rc = .Offset(R, C).Resize(2 - (R And .Row < LC), 2 - (C And .Column < LC))
  45.         End With
  47.         Set Rs = Nothing
  49.         For Each Cel In Rc
  50.             If Cel.Interior.ColorIndex = CI Then Set Rs = Cel: Exit For
  51.         Next
  53.         If Rs Is Nothing Then
  54.             Do
  55.                 Set Rs = Aleat(Rc)
  57.                 For Each Cel In AD
  58.                     NO = Rs.Address = Cel:  If NO Then Exit For
  59.                 Next
  60.             Loop While NO
  61.         End If
  62.     Loop
  63. 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
Reply

Marsh Posté le 26-03-2013 à 00:06:08    

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 :
  1. Public Const nb_rows_cols As Integer = 20
  3. Sub aaa()
  5. Dim nb_cells As Integer
  6. Dim alea1 As Integer, alea2 As Integer
  7. Dim oVirus As virus
  9. nb_cells = 0
  10. With ThisWorkbook.Worksheets(1)
  11.     .Range(.Cells(1, 1), .Cells(nb_rows_cols, nb_rows_cols)).Clear
  12.     Do
  13.         Randomize
  14.         alea1 = CInt(Int((nb_rows_cols * Rnd()) + 1))
  15.         alea2 = CInt(Int((nb_rows_cols * Rnd()) + 1))
  16.         If .Cells(alea1, alea2).Interior.ColorIndex <> 50 Then
  17.             .Cells(alea1, alea2).Interior.ColorIndex = 50
  18.             nb_cells = nb_cells + 1
  19.         Else
  20.             Exit Do
  21.         End If
  22.     Loop
  23.     .Cells(1, 1).value = nb_cells
  24.     Set oVirus = New virus
  25.     Call oVirus.initialize(50, True)
  26.     Do
  27.         oVirus.Move
  28.         .Cells(1, nb_rows_cols + 1).value = "Life: " & oVirus.Get_life
  29.     Loop Until oVirus.Get_life <= 0
  30. End With
  31. set oVirus=Nothing
  32. End Sub


module de classe "virus"

Code :
  1. Option Explicit
  3. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  5. Private Const EU As Integer = 1
  6. Private ET As Integer, life As Integer
  7. Private IsRetarded As Boolean
  8. Private x As Integer
  9. Private y As Integer
  10. Property Get Get_life() As Integer
  11.     Get_life = life
  12. End Property
  13. Public Sub initialize(ByVal iET As Integer, ByVal bIsRetarded As Boolean)
  14.     ET = iET
  15.     life = ET
  16.     IsRetarded = bIsRetarded
  17.     'start position
  18.     Randomize
  19.     x = CInt(Int((nb_rows_cols * Rnd()) + 1))
  20.     y = CInt(Int((nb_rows_cols * Rnd()) + 1))
  21.     Call get_in_cell(x, y)
  22. End Sub
  23. Private Sub get_in_cell(ByVal x As Integer, y As Integer)
  24.     If ThisWorkbook.Worksheets(1).Cells(x, y).Interior.ColorIndex = 50 Then life = ET 'eat tree get full life
  25.     ThisWorkbook.Worksheets(1).Cells(x, y).Interior.Color = vbBlack
  26. End Sub
  27. Private Sub leave_cell(ByVal x As Integer, y As Integer)
  28.     ThisWorkbook.Worksheets(1).Cells(x, y).Interior.Color = vbWhite
  29. End Sub
  30. Public Sub Move()
  31.     life = life - EU
  32.     Call leave_cell(x, y)
  33.     Randomize
  34.     Select Case CInt(Int((4 * Rnd()) + 1))
  35.         Case 1 'right
  36.             y = WorksheetFunction.Min(y + 1, nb_rows_cols)
  37.         Case 2 'left
  38.             y = WorksheetFunction.Max(y - 1, 1)
  39.         Case 3 'up
  40.             x = WorksheetFunction.Max(x - 1, 1)
  41.         Case 4 'down
  42.             x = WorksheetFunction.Min(x + 1, nb_rows_cols)
  43.     End Select
  44.     Call get_in_cell(x, y)
  45.     Sleep (100)
  46.     DoEvents
  47. 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:  

Reply

Marsh Posté le 26-03-2013 à 01:04:14    

 
            @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 …
 

Reply

Marsh Posté le 26-03-2013 à 01:04:14   

Reply

Marsh Posté le 26-03-2013 à 06:29:53    

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
Reply

Marsh Posté le 27-03-2013 à 21:52:50    

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
Reply

Marsh Posté le 27-03-2013 à 23:04:08    

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.

Reply

Marsh Posté le 28-03-2013 à 19:36:14    

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 …
 

Reply

Marsh Posté le 07-04-2013 à 15:35:53    

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

Code :
  1. Function Aleat(ByVal Rg) As Range
  2.    If TypeName(Rg) = "Range" Then Set Aleat = Rg(Fix(Rg.Count * Rnd) + 1) _
  3.                              Else Set Aleat = Range(Rg(Fix(UBound(Rg) * Rnd) + 1))
  4. End Function
  5.  
  6.  
  7. Sub ColoriagePuisRecherche()
  8.     Const CI = 44, LC = 16
  9.       Set Rg = [B2].Resize(LC, LC)
  10.            K = Rg.Count
  11.           EU = K
  12.            M = K
  13.     Union([A1:F1], Rg).Clear:  Randomize
  14.  
  15.     Do
  16.         With Aleat(Rg).Interior
  17.             If .ColorIndex = CI Then Exit Do Else .ColorIndex = CI: N = N + 1
  18.         End With
  19.     Loop
  20.  
  21.       [A1] = N
  22.     Set Rs = Aleat(Rg)
  23.  
  24.     Do
  25.         With Rs
  26.             .Select:  EU = EU - 1
  27.  
  28.             If .Interior.ColorIndex = CI Then
  29.                .Interior.ColorIndex = xlNone:  N = N - 1
  30.                 If EU < M Then M = EU
  31.                 If N = 0 Then [C1] = "EU :  " & EU:  [E1] = "EU mini :  " & M:  Exit Do
  32.                 EU = K
  33.  
  34.             ElseIf EU = 0 Then
  35.                 .Value = "    MORT !":  [C1] = "Reste :  " & N:  Exit Do
  36.             End If
  37.  
  38.             Set Rc = Application.Intersect(.Offset(-1, -1).Resize(3, 3), Rg)
  39.                  A = .Address
  40.         End With
  41.  
  42.         CA = ""
  43.  
  44.         For Each Cel In Rc
  45.             If Cel.Interior.ColorIndex = CI Then CA = CA & " " & Cel.Address
  46.         Next
  47.  
  48.         Do
  49.             If CA = "" Then Set Rs = Aleat(Rc) Else Set Rs = Aleat(Split(CA))
  50.         Loop While Rs.Address = A
  51.     Loop
  52. End Sub

Message cité 1 fois
Reply

Marsh Posté le 10-04-2013 à 11:06:49    

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

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed