Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
995 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  SOS VBA Besoin d'aide pour un programme

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

SOS VBA Besoin d'aide pour un programme

n°2181938
kenza91
Posté le 22-03-2013 à 21:16:26  profilanswer
 

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

mood
Publicité
Posté le 22-03-2013 à 21:16:26  profilanswer
 

n°2181941
tarteflamb​ee
Posté le 22-03-2013 à 22:31:16  profilanswer
 

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
n°2181969
Marc L
Posté le 23-03-2013 à 09:07:23  profilanswer
 

 
           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 …
 

n°2182113
kenza91
Posté le 24-03-2013 à 19:09:36  profilanswer
 

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

n°2182114
kenza91
Posté le 24-03-2013 à 19:20:39  profilanswer
 

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

n°2182127
Marc L
Posté le 24-03-2013 à 23:05:34  profilanswer
 

 
           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
  4. Sub Pause(Optional P = 0.04)
  5.       D = Timer:   F = D + P
  6.     While Timer < F
  7.        If Timer < D Then F = F - 86400: D = 0
  8.     Wend
  9.     DoEvents
  10. End Sub
  11. Sub ColorBug()
  12.     Dim AD(2)
  13.     Const CI = 44, LC = 20
  14.       Set Rg = [A1].Resize(LC, LC)
  15.     Rg.Clear:  Randomize
  16.     Do
  17.         With Aleat(Rg).Interior
  18.             If .ColorIndex = CI Then Exit Do Else .ColorIndex = CI: [A1] = [A1] + 1
  19.         End With
  20.     Loop
  21. '    Pause 0.5
  22.     Set Rs = Aleat(Rg)
  23.     Do
  24.         With Rs
  25.             .Select
  26.             AD(2) = AD(1):  AD(1) = AD(0):  AD(0) = .Address
  27.             If .Interior.ColorIndex = CI Then
  28.                .Interior.ColorIndex = xlNone:  [A1] = [A1] - 1:  If [A1] < 1 Then Exit Do
  29.             End If
  30.             Pause
  31.                  C = .Column > 1
  32.                  R = .Row > 1
  33.             Set Rc = .Offset(R, C).Resize(2 - (R And .Row < LC), 2 - (C And .Column < LC))
  34.         End With
  35.         Set Rs = Nothing
  36.         For Each Cel In Rc
  37.             If Cel.Interior.ColorIndex = CI Then Set Rs = Cel: Exit For
  38.         Next
  39.         If Rs Is Nothing Then
  40.             Do
  41.                 Set Rs = Aleat(Rc)
  42.                 For Each Cel In AD
  43.                     NO = Rs.Address = Cel:  If NO Then Exit For
  44.                 Next
  45.             Loop While NO
  46.         End If
  47.     Loop
  48. End Sub


n°2182363
tarteflamb​ee
Posté le 25-03-2013 à 21:33:23  profilanswer
 

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


module de classe "virus"

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

n°2182391
kenza91
Posté le 26-03-2013 à 00:00:27  profilanswer
 

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
  4. Sub Pause(Optional P = 0.04)
  5.       D = Timer:   F = D + P
  6.     While Timer < F
  7.        If Timer < D Then F = F - 86400: D = 0
  8.     Wend
  9.     DoEvents
  10. End Sub
  11. Sub ColorBug()
  12.     Dim AD(2)
  13.     Const CI = 44, LC = 20
  14.       Set Rg = [A1].Resize(LC, LC)
  15.     Rg.Clear:  Randomize
  16.     Do
  17.         With Aleat(Rg).Interior
  18.             If .ColorIndex = CI Then Exit Do Else .ColorIndex = CI: [A1] = [A1] + 1
  19.         End With
  20.     Loop
  21. '    Pause 0.5
  22.     Set Rs = Aleat(Rg)
  23.     Do
  24.         With Rs
  25.             .Select
  26.             AD(2) = AD(1):  AD(1) = AD(0):  AD(0) = .Address
  27.             If .Interior.ColorIndex = CI Then
  28.                .Interior.ColorIndex = xlNone:  [A1] = [A1] - 1:  If [A1] < 1 Then Exit Do
  29.             End If
  30.             Pause
  31.                  C = .Column > 1
  32.                  R = .Row > 1
  33.             Set Rc = .Offset(R, C).Resize(2 - (R And .Row < LC), 2 - (C And .Column < LC))
  34.         End With
  35.         Set Rs = Nothing
  36.         For Each Cel In Rc
  37.             If Cel.Interior.ColorIndex = CI Then Set Rs = Cel: Exit For
  38.         Next
  39.         If Rs Is Nothing Then
  40.             Do
  41.                 Set Rs = Aleat(Rc)
  42.                 For Each Cel In AD
  43.                     NO = Rs.Address = Cel:  If NO Then Exit For
  44.                 Next
  45.             Loop While NO
  46.         End If
  47.     Loop
  48. 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! :)
 
 
 

n°2182393
kenza91
Posté le 26-03-2013 à 00:06:08  profilanswer
 

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


module de classe "virus"

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

n°2182400
Marc L
Posté le 26-03-2013 à 01:04:14  profilanswer
 

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

mood
Publicité
Posté le 26-03-2013 à 01:04:14  profilanswer
 

n°2182402
tarteflamb​ee
Posté le 26-03-2013 à 06:29:53  profilanswer
 

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
n°2182856
kenza91
Posté le 27-03-2013 à 21:52:50  profilanswer
 

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:  

n°2182871
tarteflamb​ee
Posté le 27-03-2013 à 23:04:08  profilanswer
 

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.

n°2183056
Marc L
Posté le 28-03-2013 à 19:36:14  profilanswer
 

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 …
 

n°2184600
Marc L
Posté le 07-04-2013 à 15:35:53  profilanswer
 

 
           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

n°2185106
kenza91
Posté le 10-04-2013 à 11:06:49  profilanswer
 

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


Aller à :
Ajouter une réponse
  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 VBAProgramme débutant
problème programmation VBARe-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


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR