Excel - simpel spelletje obv twee vragenlijsten

[SquareOne]

Hi all,

Ik probeer een klein spelletje voor een team activiteit in excel te maken. Het idee is heel simpel:

• Op basis van het op een van twee knoppen te drukken zou er een random vraag getoond moeten worden
• Er zijn twee verschillende lijsten met vragen, elke lijst hoort bij een van de knoppen

Hoe heb ik het nu gebouwd:

• Blad1 bevat 3 kolommen: kolomA lijst met opeenvolgende cijfers, kolomB lijst met vragen versie X, kolomC lijst met vragen versie Y
• Blad2 bevat:
  cell1A =aselectussen(1;60)
  cell2A =vlookup obv cijfer cell1A in Blad1 kolomB
  cell1B =aselecttussen(1;60),
  cell 2B =vlookup obv cijfer cell1B in Blad2 kolom C

So far so good
Nu wil ik enkel cell1A of cell1B laten refreshen afhankelijk of op knop KeuzeA of knop KeuzeB klik, vervolgens wil ik het 'resultaat' in een tekstveld laten zien.

Vraag

• Het lukt me niet om een (twee) macro(s) te maken waarbij enkel cell1A of cell1B wordt gerefreshed afhankelijk van de knop waarop wordt gedrukt. Iemand enig idee hoe ik dit kan doen? (Via Google deze geprobeerd Cells(1, "A").Calculate , maar dan refreshen zowel 1A en 1B...)
• Het lukt me niet om een tekstveld te maken die afhankelijk van welke knop is ingedrukt het resultaat van de meest recente vlookup te laten zien. Iemand enig idee hoe ik dit kan doen?

Als er iemand anders andere ideeën heeft hoor ik het ook graag.

[ Voor 3% gewijzigd door SquareOne op 22-04-2020 22:47 ]

[F_J_K]

Verberg een vd twee met VBA. Of mooier: doe de trekking zelf in VBA. En zorg dan meteen dat een vraag niet twee keer kan worden getoond in een spel.

“6 6 6 6 6” kan een prima random trekking zijn Edit: 9 9 9 9 9 9 ook

[ Voor 15% gewijzigd door F_J_K op 22-04-2020 23:14 ]

[DirtyBird]

Dat komt doordat de rand-functies binnen excel verversen zodra er iets verandert. Daarom moet je die functies inderdaad in vba zetten en de uitkomst kun je dan evt weer in excel zetten.

[SquareOne]

F_J_K schreef op woensdag 22 april 2020 @ 23:11:
Of mooier: doe de trekking zelf in VBA. En zorg dan meteen dat een vraag niet twee keer kan worden getoond in een spel.

DirtyBird schreef op donderdag 23 april 2020 @ 07:37:
Daarom moet je die functies inderdaad in vba zetten en de uitkomst kun je dan evt weer in excel zetten.

Dank voor jullie input. Lijkt dus niet mogelijk met de functies zoals ik had bedacht.
Ben niet zo'n held met VBA. Kunnen jullie me wellicht op weg helpen?

Ik ga maar eens aan de slag met zoiets?

[ Voor 11% gewijzigd door SquareOne op 23-04-2020 08:43 ]

[F_J_K]

Je kunt een tutorial pakken ja, wel goed testen natuurlijk en zoals gezegd ook zorgen dat een trekking maar eenmaal gebeurt - ik zie dat in die code hierboven al staan dus dat gaat dan goed.

Maar als je geen VBA kent, dan zou ik dat niet doen (of juist wel als je het spelletje wilt gebruiken om wat nieuws te leren nu je toch thuis zit ). Makkelijkste: laat die knop dan niets anders doen dan een van de twee nummers en vragen verbergen.

Met Columns("A:B").EntireColumn.Hidden = True verberg je kolommen A en B. Met ..= False komt ie weer terug.

[ Voor 9% gewijzigd door F_J_K op 23-04-2020 08:49 ]

[SquareOne]

F_J_K schreef op donderdag 23 april 2020 @ 08:48:
Je kunt een tutorial pakken ja, wel goed testen natuurlijk en zoals gezegd ook zorgen dat een trekking maar eenmaal gebeurt - ik zie dat in die code hierboven al staan dus dat gaat dan goed.

Maar als je geen VBA kent, dan zou ik dat niet doen (of juist wel als je het spelletje wilt gebruiken om wat nieuws te leren nu je toch thuis zit ). Makkelijkste: laat die knop dan niets anders doen dan een van de twee nummers en vragen verbergen.

Met Columns("A:B").EntireColumn.Hidden = True verberg je kolommen A en B. Met ..= False komt ie weer terug.

Mijn werkt loopt (thuis) nog gewoon door . Maar kan tussendoor en 's avonds nog wel een beetje aanklooien met VBA. Altijd leuk om een beetje te puzzelen.

[Lustucru]

F_J_K schreef op donderdag 23 april 2020 @ 08:48:
Makkelijkste: laat die knop dan niets anders doen dan een van de twee nummers en vragen verbergen.

Met Columns("A:B").EntireColumn.Hidden = True verberg je kolommen A en B. Met ..= False komt ie weer terug.

Mag ik een simpeler variant voorstellen om mee te beginnen? gezien de vraag om alleen de laatste lookup te laten zien voldoet de volgende opzet:

In A1 een randomgetal
In B1 een kolomnummer
In C1 de vraag dmv vert.zoeken(A1,vragenlijst[],B1,0)

de code achter de knoppen hoeft dan niks meer te doen dan

code:

range("B1")=2
resp
range("B1")=3

[SquareOne]

Lustucru schreef op donderdag 23 april 2020 @ 10:51:
[...]


Mag ik een simpeler variant voorstellen om mee te beginnen? gezien de vraag om alleen de laatste lookup te laten zien voldoet de volgende opzet:

In A1 een randomgetal
In B1 een kolomnummer
In C1 de vraag dmv vert.zoeken(A1,vragenlijst[],B1,0)

de code achter de knoppen hoeft dan niks meer te doen dan

code:

range("B1")=2
resp
range("B1")=3

Interessant, slim om kolomnummer in een cell te stoppen en de knoppen daaraan te koppelen.

Edit: lijkt te werken zoals ik het wil.
Hoe simpel kan het zijn...

Edit2: om het toch nog wat moeilijker te maken: de lijstjes zijn niet even lang. In sommige gevallen geeft de vlookup dan "0".
Nog ideeën om een soort loopt te creeeren als er 0 uit komt of de random functie anders in te richten zodat deze aan sluit bij de lengte van het lijstje?

[ Voor 22% gewijzigd door SquareOne op 23-04-2020 11:34 ]

[F_J_K]

Genereer een random nummer tussen 0 en 1 en 'trek' obv. regel (random) * aantal regels. En rond dan af, natuurlijk. Even opletten of je naar beneden of boven moet afronden.

[SquareOne]

F_J_K schreef op donderdag 23 april 2020 @ 12:04:
Genereer een random nummer tussen 0 en 1 en 'trek' obv. regel (random) * aantal regels. En rond dan af, natuurlijk. Even opletten of je naar beneden of boven moet afronden.

Zal het even proberen. Maar het aantal regels is dus verschillend. Stel Lijst1 heeft 30 regels en Lijst2 heeft 60 regels dan gaat dat nog niet goed als ik deze formule gebruik in cell A1. Aantal voorbeelden:

• RAND() geeft 0.6 en 'aantal regels'=30, dan 0,6*30=18. In dat geval krijg ik in beide geval een geldige regel
• RAND() geeft 0,6 en 'aantal regels'=60, dan 0,6*60=36. In dat geval krijg ik alleen maar voor lijst 2 een geldige waarde

[F_J_K]

Dat aantal laat je dus ook afhangen van de 2 of 3 van @Lustucru


Als 2 dan rand*30, als 3 dan rand*60, zoiets. Of mooier: laat het aantal bepaald worden in je formule zodat je zonder moeite extra vragen kunt toevoegen: dat kan met bijv. aantalarg().

[Lustucru]

tsja, dan wordt de code twee regels langer:

code:

range("A1")=integer(rnd()*[lijstlengte1])
range("B1")=2

resp

range("A1")=integer(rnd()*[lijstlengte2])
range("B1")=3

De volgende stap is natuurlijk om dubbele trekkingen te vermijden, en ook de vlookup naar de vba code te verplaatsen.

F_J_K schreef op donderdag 23 april 2020 @ 13:25:
Of mooier: laat het aantal bepaald worden in je formule zodat je zonder moeite extra vragen kunt toevoegen: dat kan met bijv. aantalarg().

I like

[ Voor 29% gewijzigd door Lustucru op 23-04-2020 13:27 . Reden: tussenposter ]

[SquareOne]

F_J_K schreef op donderdag 23 april 2020 @ 13:25:
laat het aantal bepaald worden in je formule zodat je zonder moeite extra vragen kunt toevoegen: dat kan met bijv. aantalarg().

Wederom dank. Aantalarg() is een interessante functie.

Lustucru schreef op donderdag 23 april 2020 @ 13:26:
tsja, dan wordt de code twee regels langer:

code:

range("A1")=integer(rnd()*[lijstlengte1])
range("B1")=2

resp

range("A1")=integer(rnd()*[lijstlengte2])
range("B1")=3

Dank voor het idee! als ik [lijstlengte1] en [lijstlengte2] hardcoded maak werkt het prima!

Toch is het wel aantrekkelijk om de lengte van de lijst variabel te kunnen maken. En heb even zitten spelen met de aantalarg() functie. Zoals ik het idealiter zou willen doen krijg ik helaas errors. Voor het gemak heb ik de lijsten even naar hetzelfde tabblad als de macro's gekopieerd in kolommen "I" en "J"

code:

range("A1")=integer(rnd()*aantalarg("I:I")
range("B1")=2

Met een workaround werkt het wel, maar kan me voorstellen dat dit nog 'mooier' kan:

code:

    Columns("I:I").Select
    NumberRows = Application.WorksheetFunction.CountA(Selection) - 1
    Range("A1") = Int(Rnd() * NumberRows)
    Range("B1") = 2

[Lustucru]

Je hebt twee oplossingsrichtingen: een zo simpel mogelijke VBA oplossing in combinatie met werkbladformules of een volledige vba oplossing.

In het eerste geval (en dat is dus ook de suggestie van @F_J_K ) breid je de formule voor het random getal in A1 uit met een dynamisch aantal.arg, dus iets als =aselect.tussen(1,AANTALARG(VERSCHUIVING(vragenlijst!A:A;0;B1))). Je vba code blijft beperkt tot cells("B1")=x

In het tweede geval doet je alles in VBA:

* bepaal een range (met .specialcells of de omweg via laatste cell selecteren en dan xlUp, voorbeelden genoeg hier te vinden.
* genereer een willekeurig getal tussen 1 en range.rows.count. Zorg ervoor dat het getal niet twee keer getrokken kan worden. Een van de meest gebruikte algoritmes is om eerst een array op te bouwen van alle getallen, dan een random keuze te maken. Je onthoudt je keuze, plaatst het laatste getal op de plek van je keuze en vermindert vervolgens range.rows.count met 1.
* geef de vraag op de gevonden positie terug.

Die hele functie hoef je maar een keer te schrijven; achter de knop komt enkel code om die functie aan te roepen met een verwijzing naar het juiste bereik.

In je werkblad komt dan geen enkele formule meer voor.

[ Voor 88% gewijzigd door Lustucru op 25-04-2020 18:07 ]

[Lustucru]

Uitgewerkt ziet er dat zo uit: In de onderstaande code maak ik gebruik van een klasse, om de vragenfunctionaliteit maar een keer te definieren. Klik op invoegen, klassemodule en plak deze code:

Visual Basic:

Option Explicit
Dim q As Variant
Dim nrOfq As Long
Public Sub QuestionnaireInit(QuestionnaireList As Range)
    nrOfq = QuestionnaireList.Cells(QuestionnaireList.Rows.Count, 1).End(xlUp).Row
    q = QuestionnaireList.Resize(nrOfq).Value
End Sub
Public Function Question() As String
    Dim rndNr As Integer
    If nrOfq > 0 Then
        rndNr = 1 + Int(Rnd() * nrOfq)
        Question = q(rndNr, 1)
        q(rndNr, 1) = q(nrOfq, 1)
        nrOfq = nrOfq - 1
    Else
        Err.Raise vbObjectError + 513, "Function Question", "Geen vragen (meer) beschikbaar"
    End If
End Function

Geef de module de naam 'Questionnaire".

Plak in je werkblad de volgende code:

Visual Basic:

Option Explicit
Dim q1 As Questionnaire
Dim q2 As Questionnaire
Public Sub CmdBut1_Click()
    setQuestion q1, Range("B:B")
End Sub

Public Sub CmdBut2_Click()
    setQuestion q2, Range("C:C")
End Sub

Private Sub setQuestion(q As Questionnaire, questionList As Range)
    On Error GoTo errHandler
    
    If q Is Nothing Then
        Set q = New Questionnaire
        q.QuestionnaireInit questionList
    End If
    Cells(1, 1) = q.Question
    
    Exit Sub
errHandler:
    Set q = Nothing
    Cells(1, 1) = Err.Description
End Sub

Deze code zorgt ervoor dat de vragenlijsten dynamisch zijn, elke vraag maar een keer gesteld wordt en als er geen vragen meer zijn komt er een foutmelding en begint alles opnieuw. Nog meer knoppen is niet meer dan qx dimensioneren de en knopcode aangepast kopieren.

[SquareOne]

Lustucru schreef op zaterdag 25 april 2020 @ 18:07:
Uitgewerkt ziet er dat zo uit: In de onderstaande code maak ik gebruik van een klasse, om de vragenfunctionaliteit maar een keer te definieren. Klik op invoegen, klassemodule en plak deze code:

Visual Basic:

Option Explicit
Dim q As Variant
Dim nrOfq As Long
Public Sub QuestionnaireInit(QuestionnaireList As Range)
    nrOfq = QuestionnaireList.Cells(QuestionnaireList.Rows.Count, 1).End(xlUp).Row
    q = QuestionnaireList.Resize(nrOfq).Value
End Sub
Public Function Question() As String
    Dim rndNr As Integer
    If nrOfq > 0 Then
        rndNr = 1 + Int(Rnd() * nrOfq)
        Question = q(rndNr, 1)
        q(rndNr, 1) = q(nrOfq, 1)
        nrOfq = nrOfq - 1
    Else
        Err.Raise vbObjectError + 513, "Function Question", "Geen vragen (meer) beschikbaar"
    End If
End Function

Geef de module de naam 'Questionnaire".

Plak in je werkblad de volgende code:

Visual Basic:

Option Explicit
Dim q1 As Questionnaire
Dim q2 As Questionnaire
Public Sub CmdBut1_Click()
    setQuestion q1, Range("B:B")
End Sub

Public Sub CmdBut2_Click()
    setQuestion q2, Range("C:C")
End Sub

Private Sub setQuestion(q As Questionnaire, questionList As Range)
    On Error GoTo errHandler
    
    If q Is Nothing Then
        Set q = New Questionnaire
        q.QuestionnaireInit questionList
    End If
    Cells(1, 1) = q.Question
    
    Exit Sub
errHandler:
    Set q = Nothing
    Cells(1, 1) = Err.Description
End Sub

Deze code zorgt ervoor dat de vragenlijsten dynamisch zijn, elke vraag maar een keer gesteld wordt en als er geen vragen meer zijn komt er een foutmelding en begint alles opnieuw. Nog meer knoppen is niet meer dan qx dimensioneren de en knopcode aangepast kopieren.

Wauw, dank.

Ik heb een versie werkend gekregen op basis van jullie eerdere input. Ga dit zeker ook nog even proberen.