„Excel“ / „VBA“ - žaidimas

Žaidimo taisyklės

Kaip paaiškinta Wikipedia ... // en.wikipedia.org/wiki/Boggle:

„Žaidimas prasideda purtant padengtą šešiolikos kubinių kauliukų dėklą, kiekvienas iš jų turi skirtingą raidę. Kubeliai įsikuria į 4x4 dėklą, kad būtų matoma tik kiekvienos kubo viršutinė raidė. pradeda veikti trijų minučių smėlio laikmatis ir visi žaidėjai vienu metu pradeda pagrindinį žaidimo etapą.

Kiekvienas žaidėjas ieško žodžių, kurie gali būti sudaromi iš eilės gretimų kubelių raidžių, kur „gretimi“ kubeliai yra horizontaliai, vertikaliai arba įstrižai kaimyniniai. Žodžiai turi būti ne trumpesni kaip trys raidės, gali apimti atskirą ir daugiskaitą (arba kitas išvestines formas) atskirai, bet negali naudoti to paties raidžių kubo daugiau nei vieną kartą per žodį. Kiekvienas žaidėjas įrašo visus žodžius, kuriuos jis randa rašydamas ant asmeninio popieriaus lapo. Praėjus trims minutėms, visi žaidėjai turi nedelsdami nutraukti rašymą ir žaidimas patenka į taškų vertinimo etapą. "

Būtinos sąlygos

„Boggle.xls“ darbaknygėje jums reikia tinklelio, kuriame būtų 16 raidžių. Norėdami tai padaryti, D2: G5 pavyzdyje paskirsime 4X4 ląstelių diapazoną:

Įterpti apibrėžtą pavadinimą:

Meniu: įterpimas

Pasirinkimas: Nom

Spustelėkite: Définir

Vardai darbaknygėje => tipas: grotelės

Nuoroda į => įveskite: Feuil1! $ D $ 2: $ G $ 5

Spustelėkite Pridėti.

VBA kodai

 Pasirinkimas aiškus „Kintamieji de-dimensija“ modulis »Dim ListeMots () Kaip eilutė Dim alfabetas (25) Matinis grotelės (nuo 1 iki 4, 1 iki 4) Dim T_Out () Dim Indic & NumCol &, MotsTraites As Long 'procédure principale servant d'appel aux autres procédures Sub Aleatoire_ProcedurePrincipale () „Dim Wsh“ kaip darbalapis, „NbreMotsTrouves“ kaip ilgas, i &, j &, cpt MotsTraites = 0 Nustatykite Wsh = ThisWorkbook.Worksheets („Feuil2“) lapai („Feuil1“). Range („C10: H65536“) .Clear Sheets ("Feuil1"). Range ("E7") ClearContents cpt = 0 i = 1 - 4 - j = 1 - 4, jei ląstelės (i + 1, j + 3) "" Tada cpt = cpt + 1 Toliau j Kitas i Jei cpt 16 Tada MsgBox "Veillez à bien remplir la grille", vbCritical: Išeiti iš Subk. NumCol = 2 - 7 ListerMots Wsh, NumCol RetirerMotsLettresManquantes MotsDansGrille Kitas i = 3 - 8 NbreMotsTrouves = NbreMotsTrouves + (stulpeliai (i ) .Raskite ("*",,,, xlByColumns, xlPrevious) .Row - 9) Next Sheets ("Feuil1"). Range ("E7") = "Nombre de mots trouvés:" & NbreMotsTrouves pabaiga "Tirage au sort des lettres, à Commander depuis un bouton dans la feuille Sub Tirage () Dim i &, j &, skait, y i = 0 iki 25 abėcėlė (i) = Chr (65 + i) Kitas i = 1 iki 4 J = 1 iki 4 Atsitiktinis skaičius = CInt (25 * Rnd) - 5 Jei skaičius> 25 Tada skaičius = skaičius - skaičius + 10 Jei skaičius <0 Tada skaičius = skaičius + 5 grotelės (i, j) = abėcėlė (skaičius) Kitas j Kitas i i = 1 į 4 J = 1 - 4 ląstelės (i + 1, j + 3) = grotelės (i, j) Kitas j Kitas i Pabaiga Sub 'efektai ir kiti sprendimai, vadas depuis un bouton dans la feuille Sub efektas () Lakštai („Feuil1“). „Range“ („C10: H65536“). „Clear“ lapai („Feuil1“) „Range“ („E7“) „ClearContents“ lakštai („feuil1“). Liste tous les mots (sprendimai) dans la feuille Feuil2 Sub ListerMots (Sh kaip darblapis, ByVal Col kaip Integer) Dim i &, j & Ištrinti ListeMots su Sh i = 0 į .Columns (Col) .Raskite ("*",,, , xlByColumns, xlPrevious) .Row ReDim išsaugoti ListeMots (j) ListeMots (j) = .Cells (i + 2, Col) j = j + 1 Kitas pabaiga su MotsTraites = MotsTraites + UBound (ListeMots) Pabaiga „Enlève de la li Ste, les mots contenant des LotusManquantes () Dim LotusMotsTemp () Kaip String, lettr $, mot $ Dim i &, j &, k &, Test As Boolean Dim MonDico1 As Objektas, MonDico2 kaip objektas, c lettresutilisees = Diapazonas („grotelės“) '-----> Meniu įterpimas / Noms / Définir rinkinys MonDico1 = CreateObject („Scripting.Dictionary“) Kiekvienam c Cortas lettresutilisees MonDico1 (c) = " "Next c Set MonDico2 = CreateObject (" Scripting.Dictionary ") Kiekvienam c abėcėlėje, jei ne MonDico1.Exists (c) Tada MonDico2 (c) =" "Next c lettresmanquantes = taikymas.Perkėlimas (MonDico2.Keys) ListeMotsTemp = ListeMots Ištrinti „ListeMots“ i = 0 į „UBound“ (ListeMotsTemp) mot = ListeMotsTemp (i) už j = 1 į „UBound“ (lettresmanquantes) lettr = lettresmanquantes (j, 1) Jei „InStr“ (mot, lettr) = 0 Tada testas = tikras kitas testas = False Exit for End Jei sekantis j Jei testas Tada ReDim Preserve ListeMots (k) ListeMots (k) = ListeMotsTemp (i) k = k + 1 pabaiga dure de recherche des mots Sub MotsDansGrille () Dim c, mot D ė r ė g ė s kaip diapazonas Dim i &, j &, NumLettre & Dim firstAddress, Žymėti kaip Boolean Dim MotsTouvesDansGrille (), k & Dim CellulesUtilisees kaip objektas i = 1 - 4 4 grotelės (i, j) = ląstelės (i, j) Kitas j Kitas i kiekvienam motui ListeMots Set rngTrouve = diapazonas („grotelės“) „Cells.Find“ (kairėn (mot, 1)) Jei ne rngTrouve yra nieko Ištrinti T_Out indikatorius = 0 ReDim išsaugoti T_Out (indikatorius) T_Out (indikatorius) = rngTrouve.Address Set CellulesUtilisees = CreateObject ("Scripting.Dictionary") CellulesVoisines CellulesUtilisees, rngTrouve, mot, 1 firstAddress = rngTrouve.Address Do Set rngTrouve = Range (" Tinklelis "".) Cells.FindNext (rngTrouve) Ištrinti T_Out indikatorius = 0 ReDim išsaugoti T_Out (indikatorius) T_Out (Indicator) = rngTrouve.Address Set CellulesUtilisees = CreateObject ("Scripting.Dictionary") CellulesVoisines CellulesUtilisees, rngTrouve, mot, 1 Jei rodiklis = Len (mot) - 1 Tada vėliava = tikra indikatoriui = LBound (T_Out) į UBound (T_Out) Jei diapazonas (T_Out (indikatorius))., Indic + 1, 1) Tada vėliava = False: Išeiti kitam indikatoriui Kitai vėliavai = False End Jei vėliava tada išeiti Do Loop, o ne rngTrouve Nothing And rngTrouve.Address firstAddress End Jei vėliava tada ReDim išsaugoti MotsTouvesDansGrille (k) MotsTouvesDansGrille (k) MotsTouvesDansGrille (k) = mot k = k + 1 Pabaiga Jei sek. mot Jei k 0 Tada k = LBound (MotsTouvesDansGrille) į UBound (MotsTouvesDansGrille) lapus ("Feuil1"). Ląstelės (10 + k, NumCol + 1) = MotsTouvesDansGrille ( k) Kitas k Pabaigos pabaiga Jei baigiamajame poskyryje yra „Sub CellulesVoisines“ („ByRef Obj“, „CelInitiale“, „Strmot“, „niveau“) „Dim Cel“ kaip diapazonas, „Plage As Range“, „Flag“ kaip „Boolean“, c Įjungta klaida Tęsti „Next Set Plage“ = intervalas („CelInitiale“) .Offset (-1, -1), CelInitiale.Offset (1, 1)) Obj.Add CelInitiale.Address, Mid (Strmot, niveau, 1) Už kiekvieną Cel In Plage Jei rodiklis + 1 = Len (Strmot), tada Exit If Cel.Value = Mid (Strmot, niveau + 1, 1) Tada Flag = True kiekvienam c Obj.Keys Jei c = Cel.Adress Tada Flag = False Next Jei vėliava tada Obj.Add Cel.Address, Mid ( Strmot, niveau + 1, 1) Indikatorius = indikatorius + 1 atkūrimo išsaugojimas T_Out (indikatorius) T_Out (indikatorius) = Cel.Adelsas CellulesVoisines Obj, Cel, Strmot, niveau + 1 Pabaiga Jei pabaiga Jei kitas Cel Pabaiga Įtraukti į standartinį modulį: Iš skaičiuoklės paspauskite ALT + F11 įdėklas / modulis.

Pastabos

Visų pirma atkreipkite ypatingą dėmesį į 2 skilties stulpelius: B skiltis (nuo B2 iki BX: 3 raidžių žodžiai), C skiltis (nuo C2 iki Cx: 4 raidžių žodžiai), ....., G stulpelis (iš G2 į Gx: 8 raidžių žodžiai)