XL 2013 Comparer valeurs dans 4 cellules. Résolu par Soan.

Lone-wolf

XLDnaute Barbatruc
Bonjour le Forum, :)

Désolé si le titre n'est pas vraiment parlant, ne sachant pas quel titre donner à ma demande. J'aimerais ajouter une condition en comparant avant, les textes suivants:

"as", "dix", "valet", "dame", "roi". C'est textes peuvent apparaître simultanément en B7, B8 - F7, F8.

Si ces cellules ont les même textes, alors exécute ceci:..... . Ceci en rapport avec le Black Jack, dans le cas où le croupier et le joueur font un black jack.
 

soan

XLDnaute Barbatruc
Inactif
Bonjour Lone-wolf,

Je te propose ce code VBA :
VB:
Sub Essai()
  If InStr(1, "as dix valet dame roi", [B7], 1) = 0 Then Exit Sub
  If [B7] <> [B8] Or [B7] <> [F7] Or [B7] <> [F8] Then Exit Sub
  'Black Jack !!!
  'mets ici tout le code concerné par le croupier et le joueur
  'et pas de triche, hein ???  ;P
End Sub
soan
 

Lone-wolf

XLDnaute Barbatruc
Bonjour Soan :)

Merci pour ton intervention. Mais, je ne saisi pas ton code, pourquoi = 0??

EDIT: voici le code actuel.

VB:
        Select Case .Range("b7")
        Case Is = "dix", "valet", "dame", "roi"
            Select Case .Range("d8")
            Case Is = 1
                .Range("b3") = 21
                POrdi = .Range("h3")
                PJoueur = .Range("b3")
                LbBJ.Visible = True
                LbBJ = "BLACK JACK"
                LbCroupier.Visible = True
                LbCroupier = "Le joueur gagne !"
                PlayerMoney = Val(PlayerMoney) + Val(Mise) + Val(Mise / 2)
                MoneyBank = Val(MoneyBank) - Val(Mise) - Val(Mise / 2)
                Exit Sub
            End Select
        End Select

        Select Case .Range("b8")
        Case Is = "dix", "valet", "dame", "roi"
            Select Case .Range("d7")
            Case Is = 1
                .Range("b3") = 21
                POrdi = .Range("h3")
                PJoueur = .Range("b3")
                LbBJ.Visible = True
                LbBJ = "BLACK JACK"
                LbCroupier.Visible = True
                LbCroupier = "Le joueur gagne !"
                PlayerMoney = Val(PlayerMoney) + Val(Mise) + Val(Mise / 2)
                MoneyBank = Val(MoneyBank) - Val(Mise) - Val(Mise / 2)
                Exit Sub
            End Select
        End Select

        Select Case .Range("f7")
        Case Is = "dix", "valet", "dame", "roi"
            Select Case .Range("h8")
            Case Is = 1
                .Range("h3") = 21
                POrdi = .Range("h3")
                PJoueur = .Range("b3")
                LbBJ.Visible = True
                LbBJ = "BLACK JACK"
                LbCroupier.Visible = True
                LbCroupier = "La banque gagne !"
                MoneyBank = Val(MoneyBank) + Val(Mise) + Val(Mise / 2)
                PlayerMoney = Val(PlayerMoney) - Val(Mise) - Val(Mise / 2)
                Exit Sub
            End Select
        End Select

        Select Case .Range("f8")
        Case Is = "dix", "valet", "dame", "roi"
            Select Case .Range("h7")
            Case Is = 1
                .Range("h3") = 21
                POrdi = .Range("h3")
                PJoueur = .Range("b3")
                LbBJ.Visible = True
                LbBJ = "BLACK JACK"
                LbCroupier.Visible = True
                LbCroupier = "La banque gagne !"
                MoneyBank = Val(MoneyBank) + Val(Mise) + Val(Mise / 2)
                PlayerMoney = Val(PlayerMoney) - Val(Mise) - Val(Mise / 2)
                Exit Sub
            End Select
        End Select

Comment placer les deux lignes de code?
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
On sort de la sub si ça vaut 0, car 0 signifie que la valeur de la cellule B7
n'a pas été trouvée dans la chaîne de caractères "as dix valet dame roi".

Ainsi, on passe à la 2ème ligne seulement si B7 contient une des valeurs
as ; dix ; valet ; dame ; roi ; le second test est pour voir si B7 est pareil
que B8, F7, et F8 ; si c'est non : on sort de la sub.

Si c'est oui, on fait la suite : ton code VBA en cas de Black Jack. :)

soan
 

soan

XLDnaute Barbatruc
Inactif
J'ai vu ton EDIT, avec l'ajout de ton code VBA.

Essaye en plaçant tout ton code VBA sous ma 2ème ligne de test,
donc sous celle-ci :
VB:
If [B7] <> [B8] Or [B7] <> [F7] Or [B7] <> [F8] Then Exit Sub
Après, je ne peux pas t'aider plus, car c'est le jeu du Black Jack,
avec toutes ses règles ; et moi, je ne le connais que de nom.


soan
 

Lone-wolf

XLDnaute Barbatruc
Re Soan,

ok, compris. Merci encore et très bon dimanche.
VB:
Sub Triche()
'Dix-manches ??...
'Ouuuuuupps! J'ai encore triché!
'J'en ai que deux!
End Sub
m.gif
s.gif
 

Lone-wolf

XLDnaute Barbatruc
Re Sloan,

j'ai du mal à placer les lignes de code, alors voici la macro. Oû dois-je mettre ces lignes?

VB:
Private Sub Attente_Click()

    With Sh
        Image4.Picture = LoadPicture(Chemin & .Cells(8, 7) & ".gif")

        Select Case .Range("h3")
        Case Is < .Range("b3")
            Call Cartes_Ordi
        End Select

        On Error Resume Next

        x = 8
        For i = 1 To 4
            If IsEmpty(.Cells(x, 7)) Then
                Exit For
            Else
                x = x + 1
                Joue_Carte
                t = Timer + 0.8: Do Until Timer > t: DoEvents: Loop
                Me.Controls("Image" & x).Picture = LoadPicture(Chemin & .Cells(x, 7) & ".gif")
            End If
        Next i


        '        If [B7] <> [B8] Or [B7] <> [F7] Or [B7] <> [F8] Then
        '        If InStr(1, "as dix valet dame roi", [B7], 1) = 0 Then
        '            POrdi = .Range("h3")
        '            PJoueur = .Range("b3")
        '            LbCroupier.Visible = True
        '            LbCroupier = "Egalité !"
        '            Exit Sub
        '        End If

        Select Case .Range("b7")
        Case Is = "dix", "valet", "dame", "roi"
            Select Case .Range("d8")
            Case Is = 1
                .Range("b3") = 21
                POrdi = .Range("h3")
                PJoueur = .Range("b3")
                LbBJ.Visible = True
                LbBJ = "BLACK JACK"
                LbCroupier.Visible = True
                LbCroupier = "Le joueur gagne !"
                PlayerMoney = Val(PlayerMoney) + Val(Mise) + Val(Mise / 2)
                MoneyBank = Val(MoneyBank) - Val(Mise) - Val(Mise / 2)
                Exit Sub
            End Select
        End Select

        Select Case .Range("b8")
        Case Is = "dix", "valet", "dame", "roi"
            Select Case .Range("d7")
            Case Is = 1
                .Range("b3") = 21
                POrdi = .Range("h3")
                PJoueur = .Range("b3")
                LbBJ.Visible = True
                LbBJ = "BLACK JACK"
                LbCroupier.Visible = True
                LbCroupier = "Le joueur gagne !"
                PlayerMoney = Val(PlayerMoney) + Val(Mise) + Val(Mise / 2)
                MoneyBank = Val(MoneyBank) - Val(Mise) - Val(Mise / 2)
                Exit Sub
            End Select
        End Select

        Select Case .Range("f7")
        Case Is = "dix", "valet", "dame", "roi"
            Select Case .Range("h8")
            Case Is = 1
                .Range("h3") = 21
                POrdi = .Range("h3")
                PJoueur = .Range("b3")
                LbBJ.Visible = True
                LbBJ = "BLACK JACK"
                LbCroupier.Visible = True
                LbCroupier = "La banque gagne !"
                MoneyBank = Val(MoneyBank) + Val(Mise) + Val(Mise / 2)
                PlayerMoney = Val(PlayerMoney) - Val(Mise) - Val(Mise / 2)
                Exit Sub
            End Select
        End Select

        Select Case .Range("f8")
        Case Is = "dix", "valet", "dame", "roi"
            Select Case .Range("h7")
            Case Is = 1
                .Range("h3") = 21
                POrdi = .Range("h3")
                PJoueur = .Range("b3")
                LbBJ.Visible = True
                LbBJ = "BLACK JACK"
                LbCroupier.Visible = True
                LbCroupier = "La banque gagne !"
                MoneyBank = Val(MoneyBank) + Val(Mise) + Val(Mise / 2)
                PlayerMoney = Val(PlayerMoney) - Val(Mise) - Val(Mise / 2)
                Exit Sub
            End Select
        End Select

        Select Case .Range("b3")
        Case Is = .Range("h3")
            Select Case .Range("h3")
            Case Is = .Range("b3")
                POrdi = .Range("h3")
                PJoueur = .Range("b3")
                LbCroupier.Visible = True
                LbCroupier = "Egalité !"
                Exit Sub
            End Select
        End Select

        Select Case .Range("h3")
        Case Is > 21
            POrdi = .Range("h3")
            PJoueur = .Range("b3")
            LbCroupier.Visible = True
            LbCroupier = "Le joueur gagne !": Gagne
            MoneyBank = Val(MoneyBank) - Val(Mise)
            PlayerMoney = Val(PlayerMoney) + Val(Mise)
            Exit Sub
        End Select

        Select Case .Range("h3")
        Case Is <= 21, Is > .Range("b3")
            POrdi = .Range("h3")
            PJoueur = .Range("b3")
            LbCroupier.Visible = True
            LbCroupier = "La banque gagne !"
            MoneyBank = Val(MoneyBank) + Val(Mise)
            PlayerMoney = Val(PlayerMoney) - Val(Mise)
            Exit Sub
        End Select

        Select Case .Range("h3")
        Case Is > 21, .Range("b3") > 21
            POrdi = .Range("h3")
            PJoueur = .Range("b3")
            LbCroupier.Visible = True
            LbCroupier = "Personne gagne !"
            Exit Sub
        End Select
    End With

End Sub
 

soan

XLDnaute Barbatruc
Inactif
Re,

* la 1ère feuille est vide, et s'appelle "Black Jack"

* Alt F11 pour voir le code VBA (il se compile
correctement, mais ne dois pas être exécuté)


Je te laisse étudier le code VBA ;
à te lire pour avoir ton avis. ;)

soan
 

Pièces jointes

  • Exo Lone-wolf.xlsm
    19 KB · Affichages: 14

Lone-wolf

XLDnaute Barbatruc
Bonjour Soan,

comme je ne voyait pas de réponse, j'ai créé une macro dans un nouveau classeur pour test, et elle est fonctionnelle.
VB:
     Select Case [B7]
        Case Is = "as", "dix", "valet", "dame", "roi"
            Select Case [B8]
            Case Is = "as", "dix", "valet", "dame", "roi"
                Select Case [F7]
                Case Is = "as", "dix", "valet", "dame", "roi"
                    Select Case [F8]
                    Case Is = "as", "dix", "valet", "dame", "roi"
                        If [B3] = 21 And [H3] = 21 Then
                            PJoueur = .Range("b3")
                            POrdi = .Range("h3")
                            LbBJ.Visible = True
                            LbBJ = "BLACK JACK"
                            LbCroupier.Visible = True
                            LbCroupier = "Egalité !"
                        Else
                            Exit Sub
                        End If
                    End Select
                End Select
            End Select
        End Select

Je vais regarder le classeur et voir toi comment tu as fait. Dans tout les cas, merci encore d'etre intervenu et d'avoir pris du temps pour créer la macro.
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Bonjour Lone-wolf,

Quand tu liras tout le code VBA du fichier de mon post #10,
tu comprendras pourquoi j'ai été aussi long à répondre. ;)

Ce serait bien que tu perdes l'habitude d'utiliser Case Select
alors que tu mets dedans un seul cas : un simple If suffit !
pour 2 cas, tu as If ... Then ... Else ... ; et il y a aussi :

VB:
If condition1 Then
  ...
ElseIf condition2
  ...
ElseIf condition3
  ...
End If
Bien sûr, pour plusieurs cas, le Case Select reste utile !

Pour tes références de cellules, le code sera plus lisible si tu les mets en majuscule ;
exemple : H3 au lieu de h3 ; quand tu regardes les en-têtes de colonnes d'une
feuille Excel, les lettres sont bien en majuscules, pas en minuscules ; et ainsi,
dans le code VBA, les références de cellules se repèrent plus facilement. :)

J'ai optimisé ainsi le code VBA de ton post #11 :

Code:
Function BJ(cel As Range) As Byte
  BJ = -(InStr(1, "as dix valet dame roi", cel, 1) > 0)
End Function

Sub Essai()
  If BJ([B7]) = 0 Or BJ([B8]) = 0 Or BJ([F7]) = 0 Or BJ([F8]) = 0 Then Exit Sub
  If [B3] <> 21 Or [H3] <> 21 Then Exit Sub
  PJoueur = [B3]: POrdi = [H3]: LbBJ.Visible = -1: LbBJ = "BLACK JACK"
  LbCroupier.Visible = -1: LbCroupier = "Egalité !"
End Sub
Le code que tu as montré est incomplet, puisqu'il n'y a que le cas de l'égalité ;
où sont donc passés les 2 autres cas ? le joueur gagne, et la banque gagne ?
ah, et puis il manque aussi tes 4 cas de "Black Jack" : 2 pour le joueur et 2
autres pour la banque ; mais bon, si tu écris que ta macro est fonctionnelle,
je veux bien te croire. ;)

À te lire pour avoir ton avis.


soan
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Re,

Lis d'abord mon post #12 précédent.

Ci-dessous, code VBA du fichier inclus dans mon post #10 (68 lignes) ; pour que
la compilation ne bloque pas, j'ai nommé la feuille unique "Black Jack", car il y a :
With Worksheets("Black Jack") ; tu devras adapter le nom de la feuille ; toujours
pour éviter le blocage de la compilation, j'ai ajouté les 2 subs vides Cartes_Ordi()
et Joue_Carte() ; note bien que les 4 cas possibles de "Black Jack" sont traités
par la sub privée BJck(), ce qui allège bien évidemment ton code VBA initial. :)

VB:
Option Explicit

Dim LbCroupier As ListBox, LbBJ As ListBox
Dim PM#, MB#, MJ# 'PlayerMoney, MoneyBank, Mise du Joueur
Dim POrdi%, PJoueur%, BJ As Byte 'BJ = 1 si Black Jack

Private Sub BJck(Carte$, k1 As Byte, k2 As Byte) 'cette sub est appelée par la sub Attente_Click()
  Dim chn$, s%, m#
  If InStr(1, "dix valet dame roi", Carte, 1) = 0 Then Exit Sub 'ni as, ni 10, ni valet, ni dame, ni roi
  If [B7] <> [B8] Or [B7] <> [F7] Or [B7] <> [F8] Then Exit Sub 'un de {as à roi}, mais pas 4× le même !
  'si on continue à partir d'ici, c'est qu'il y a eu 4 as, ou 4 dix, ou 4 valets, ou 4 dames, ou 4 rois
  BJ = -(k1 = 1): If BJ = 0 Then Exit Sub
  With Worksheets("Black Jack") 'nom de feuille à adapter
    If k2 = 1 Then
      .[B3] = 21: POrdi = .[H3]: PJoueur = 21: s = 1: chn = "Le joueur"
    Else
      .[H3] = 21: POrdi = 21: PJoueur = .[B3]: s = -1: chn = "La banque"
    End If
  End With
  If BJ = 1 Then
    m = MJ * 1.5: PM = PM + s * m: MB = MB - s * m
    LbCroupier.Visible = -1: LbCroupier = chn & " gagne !"
    LbBJ.Visible = -1: LbBJ = "BLACK JACK"
  End If
End Sub

Private Sub Attente_Click()
  On Error Resume Next
  Dim Chemin$, Image4 As IPictureDisp 'pour le type IPictureDisp, je ne suis pas sûr ; si ça ne marche pas,
  'essaye : Image4 As Object ; ou Image4 As Variant ; ou Image4 (si type non indiqué : idem que Variant).
  Dim t#, x&, i&
  With Worksheets("Black Jack") 'nom de feuille à adapter
    Image4.Picture = LoadPicture(Chemin & .Cells(8, 7) & ".gif"): If .[H3] < .[B3] Then Cartes_Ordi
    x = 8
    For i = 1 To 4
      If IsEmpty(.Cells(x, 7)) Then Exit For
      x = x + 1: Joue_Carte: t = Timer + 0.8: Do Until Timer > t: DoEvents: Loop
      Application.Controls("Image" & x).Picture = LoadPicture(Chemin & .Cells(x, 7) & ".gif")
    Next i
    BJck .[B7], .[D8], 1: If BJ = 1 Then Exit Sub
    BJck .[B8], .[D7], 1: If BJ = 1 Then Exit Sub
    BJck .[F7], .[H8], 2: If BJ = 1 Then Exit Sub
    BJck .[F8], .[H7], 2: If BJ = 1 Then Exit Sub
    If .[B3] = .[H3] Then
      POrdi = .[H3]: PJoueur = .[B3]: LbCroupier.Visible = -1: LbCroupier = "Egalité !": Exit Sub
    End If
    Select Case .[H3]
      Case Is > 21
        POrdi = .[H3]: PJoueur = .[B3]: MB = MB - MJ: PM = PM + MJ
        LbCroupier.Visible = -1: LbCroupier = "Le joueur gagne !"
        Exit Sub
      Case Is <= 21, Is > .[B3]
        POrdi = .[H3]: PJoueur = .[B3]: MB = MB + MJ: PM = PM - MJ
        LbCroupier.Visible = -1: LbCroupier = "La banque gagne !"
        Exit Sub
      Case Is > 21
        If .[B3] > 21 Then
          POrdi = .[H3]: PJoueur = .[B3]
          LbCroupier.Visible = -1: LbCroupier = "Personne gagne !"
          Exit Sub
        End If
    End Select
  End With
End Sub

Sub Cartes_Ordi(): End Sub 'sub ajoutée pour éviter le blocage de la compilation
Sub Joue_Carte(): End Sub 'sub ajoutée pour éviter le blocage de la compilation
As-tu remarqué ceci : Mise + Mise / 2 = Mise + (Mise × 50%) = Mise × 1,5 ;
donc ensuite, y'a plus qu'à ajouter ou enlever Mise × 1,5 ; ça simplifie !

À la fin de la sub BJck(), c'est : m = MJ * 1.5


soan
 
Dernière édition:

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T