MS Excel

Přeji hezké dopoledne. Vím, že už toto téma bylo řešeno víc krát, ale žádné z daných řešení mi nefunguje. Mám Excel 2007, vytvořen sešit s 9 listy. První list obsahuje po dvě náhodně generované otázky z dalších 8 listů (okruhy otázek). Pak vše exportuji přes hromadnou korespondenci do Wordu kde sestavuji test s hlavičkou atd. Poslední list Wordu obsahuje kontrolní tabulku kde jsou uvedeny správné odpovědi a bude hodnocení daného uchazeče. I když je otázek asi 300 stává se mi, že se po vygenerování opakují. Snažil jsem se použít nalezené funkce pro kontrolu dat a zadat Excelu ať kontroluje shodu, ale nevede se mi.

VBA neovládám a proto prosím o radu. Předem děkuji za pomoc.

Zaslat odpověď >

Pavlus(7.3.2015 9:14)#024013

Pokud generuješ náhodná čísla, tak by např. stačilo si v Excelu vytvořit nějaký seznam již použitých a pokud se nově vygenerované číslo bude shodovat s již použitým, pak se vygeneruje nové.
Toto řešení by bylo zřejmě přes VBA, bez přílohy ani ránu...
P.citovat

FiFoml(24.3.2015 13:01)#024254

Omlouvám se za odmlčení. V rámci jiných povinností muselo jít tohle chvíli stranou.
Zasílám soubor, ve kterém bych potřeboval udělat následovné:
Do listu Test, sloupec C generovat náhodné otázky z listů Okruh A až Okruh I, sloupec A. Z každého okruhu právě dvě otázky. Fuknce RANDBETWEEN něco takového umí, jen mi nejde odstranit opakování.
Do listu klíč, sloupec C, dát správné odpovědi, které jsou vždy uvedeny u otázky v daném okruhu.
Otázka i možné odpovědi budu vždy uvedeny v jedné buňce, není nutno míchat otázky ani nic podobného.

Vygenerované věci pak importuji přes hromadnou korespondenci do Wordu, kde se i starám o formátování.

Děkuji za pomoc.

Příloha: zip

24254_test.zip (13kB, staženo 48x)

citovat

elninoslov(27.3.2015 15:20)#024293

Prvé tlačítko ti vytvorí Test tak, že sú z každého okruhu 2 náhodné po sebe. Ak majú byť premiešané aj okruhy, použi druhé tlačítko.

Příloha: rar

24293_randomtest.rar (31kB, staženo 112x)

citovat

FiFoml(28.3.2015 10:19)#024303

Super. Děkuji. Je to přesně tak, jak jsem potřeboval!citovat

Lukas523(3.9.2019 10:48)#044121

elninoslov napsal/a:

Prvé tlačítko ti vytvorí Test tak, že sú z každého okruhu 2 náhodné po sebe. Ak majú byť premiešané aj okruhy, použi druhé tlačítko.Příloha: 24293_randomtest.rar (31kB, staženo 43x)

Jak by to bylo se kdybych chtěl 3 nebo 4 otázky bez opakování :(citovat

lubo(3.9.2019 14:41)#044127

Např. drobná modifikace:
Const pocet_otazek = 4

Sub NahodneOtazky()
Dim Okruhy() As String, n As String
Dim Otazky() As Variant
Dim OtazOkr(1 To 2) As Integer
Dim SpoluOtazC(1 To 36) As String, SpoluOdpoC(1 To 36) As String
Dim i As Integer, OC As Integer, pocet As Integer
Dim id As Long
Dim AktId As Long

Okruhy = Split("Okruh A,Okruh B,Okruh C,Okruh D,Okruh E,Okruh F,Okruh G,Okruh H,Okruh I", ",")
OC = 0
Randomize
For i = LBound(Okruhy) To UBound(Okruhy)
With Sheets(Okruhy(i))
pocet = .Range("A1").End(xlDown).Row

Randomize
ReDim Otazky(1 To pocet)

For id = 1 To pocet
Otazky(id) = id
Next id

For id = pocet To pocet - pocet_otazek + 1 Step -1
AktId = Int(Rnd() * id) + 1
OC = OC + 1
SpoluOtazC(OC) = .Cells(Otazky(AktId), 1).Value
SpoluOdpoC(OC) = .Cells(Otazky(AktId), 2).Value

Otazky(AktId) = Otazky(id)
Next id
End With
Next i
Range("C1").Resize(UBound(Okruhy) * pocet_otazek, 1) = Application.Transpose(SpoluOtazC)
Sheets("Klic").Range("C2").Resize(UBound(Okruhy) * pocet_otazek, 1) = Application.Transpose(SpoluOdpoC)
End Sub
citovat

Téma: Otázky bez opakování

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje