20800_vysledek.jpg
něco takového ?
Příloha: 
20803_nahodne-datum.zip (18kB, staženo 65x)
citovat20803_nahodne-datum.zip (18kB, staženo 65x)
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Náhodný výběr několika hodnot ze sloupce
MS Excel
Téma: Náhodný výběr několika hodnot ze sloupce 
Zaslal/a zac1234 30.7.2014 14:33
Ahoj, potřeboval bych pomoct s výběrem několika čísel z jednoho sloupce. Ve sloupci např.A jsou čísla pracovních dní příslušného měsíce s mezerou pro víkendové dny, tedy např.1,2,3,4,"mezera","mezera"7,8,9,10,11,"mezera","mezera" atd.(max.31 řádků). Z tohoto sloupce bych potřeboval např. do sloupce B vybrat náhodně např. 5 čísel definovaných v buňce např. C1 s vynecháním mezer. Čísla by se měla vypsat ve stejném řádku. Poradí někdo? Výsledek by měl vypadat např. takto. Díky M.
Jaksi to nemůžu otevřít. Prosím o xls nebo sem hodit VBA kód. Díkycitovat
do A2 dej vzorec:
=KDYŽ(DENTÝDNE(DATUM($C$1;$B$1;ŘÁDEK(A2)-1);2)>5;"vikend";ŘÁDEK(A2)-1)
a zkopírovat až do A32
do C1 rok, např. 2014
do B1 měsíc, např. 8
do C2 zadej požadovaný počet náhodných výběrů , např. 5
a do listu vložit makro:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And Target.Row = 2 Then
k = Range("C2")
Dim CisloNeduplicitni As New Collection
Range("B2:B32").ClearContents
If k < 1 Then Exit Sub
On Error Resume Next
While CisloNeduplicitni.Count < k
xx:: m = Int(Rnd() * 31) + 1
If IsNumeric(Cells(m, "A")) Then
CisloNeduplicitni.Add m, CStr(m)
Else
GoTo xx
End If
Wend
For x = 1 To k
Cells(CisloNeduplicitni(x), "B") = CisloNeduplicitni(x) - 1
Next
On Error GoTo 0
End If
End Subcitovat
=KDYŽ(DENTÝDNE(DATUM($C$1;$B$1;ŘÁDEK(A2)-1);2)>5;"vikend";ŘÁDEK(A2)-1)
a zkopírovat až do A32
do C1 rok, např. 2014
do B1 měsíc, např. 8
do C2 zadej požadovaný počet náhodných výběrů , např. 5
a do listu vložit makro:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And Target.Row = 2 Then
k = Range("C2")
Dim CisloNeduplicitni As New Collection
Range("B2:B32").ClearContents
If k < 1 Then Exit Sub
On Error Resume Next
While CisloNeduplicitni.Count < k
xx:: m = Int(Rnd() * 31) + 1
If IsNumeric(Cells(m, "A")) Then
CisloNeduplicitni.Add m, CStr(m)
Else
GoTo xx
End If
Wend
For x = 1 To k
Cells(CisloNeduplicitni(x), "B") = CisloNeduplicitni(x) - 1
Next
On Error GoTo 0
End If
End Subcitovat
Díky za makro. Funguje ale jen do určitého počtu náhodných výběrů. Pak to vynuluje buňku měsíce (B1). A v měsíci únoru při 28 dnech to nestydatě vypíše číslo třeba 30. Jinak mám definováno =KDYŽ(DENTÝDNE(DATUM($C$1;$B$1;ŘÁDEK(A2)-1);2)>5;"";ŘÁDEK(A2)-1).Takže by to chtělo vynechávat veškeré prázdné prázdné buňky ve sloupci A. Dík za případné další rady.citovat
upraivl jsem jen vzorec. mě to funguje nevím jak je možné, že by to mazalo B1, v kodu nic takového není.
upravený vzorec:
=KDYŽ(ŘÁDEK(A2)>DEN(EOMONTH(DATUM($C$1;$B$1;1);0));"";KDYŽ(DENTÝDNE(DATUM($C$1;$B$1;ŘÁDEK(A2)-1);2)>5;"";ŘÁDEK(A2)-1))
edit:
ještě oprava vzorce:
=KDYŽ(ŘÁDEK(A2)-1>DEN(EOMONTH(DATUM($C$1;$B$1;1);0));"";KDYŽ(DENTÝDNE(DATUM($C$1;$B$1;ŘÁDEK(A2)-1);2)>5;"";ŘÁDEK(A2)-1))
upravený vzorec:
=KDYŽ(ŘÁDEK(A2)>DEN(EOMONTH(DATUM($C$1;$B$1;1);0));"";KDYŽ(DENTÝDNE(DATUM($C$1;$B$1;ŘÁDEK(A2)-1);2)>5;"";ŘÁDEK(A2)-1))
edit:
ještě oprava vzorce:
=KDYŽ(ŘÁDEK(A2)-1>DEN(EOMONTH(DATUM($C$1;$B$1;1);0));"";KDYŽ(DENTÝDNE(DATUM($C$1;$B$1;ŘÁDEK(A2)-1);2)>5;"";ŘÁDEK(A2)-1))
Příloha: 20826_nahodne-datum2.zip (18kB, staženo 31x)
citovat20826_nahodne-datum2.zip (18kB, staženo 31x)Posílám xls. Už teď při otevření je špatně, že to vypsalo náhodně 30., když je vedle prázdná buňka a pak zkus dosadit do C2 hodnotu 15 - mně to vynuluje B1. Počet dnů v měsící řešit nemusíme, to mám zpracované, ale pole výběru čísel bude vždy A2:A32 a bude tam různý počet prázdných buněk.
Příloha: 20830_nahdat.zip (8kB, staženo 32x)
citovat20830_nahdat.zip (8kB, staženo 32x)Doplněné a upravené.
vzorce nebyly roztažené až do řádku 32, ale jen 29.
upravené makro, aby nebyl možný požadavek více náhodných výběrů, než je počet dnů a vyloučení vynulování B1, k čemuž opravdu mohlo dojít, ale mě se to ani jednou nestalo, až na tvém xls.
vzorce nebyly roztažené až do řádku 32, ale jen 29.
upravené makro, aby nebyl možný požadavek více náhodných výběrů, než je počet dnů a vyloučení vynulování B1, k čemuž opravdu mohlo dojít, ale mě se to ani jednou nestalo, až na tvém xls.
Příloha: 20836_nahdat2.zip (12kB, staženo 30x)
citovat20836_nahdat2.zip (12kB, staženo 30x)Zasílám přílohu xls, list jiný měsíc - nefunguje při změně měsíce, to by mi tak nevadilo, dny měsíců už mi fungují a spolehlivě, akorát jsem zjistil, že je rozdíl mezi prázdnou buňkou a buňkou vyplněnou ="", to bych viděl jako vyřešené. List maximální počet hodnot (i když se to asi nestane, ale pracovní dny by mohly být všechny, proto jenom simulace s čísly 1-31) - nikdy to nehodí náhodné číslo 31 při jakémkoliv zadání a při maximálním počtu 31 to začne přemýšlet a přemýšlí a přemýšlí. Ale už se blížíme ideálu. Díky za čas, kdybych já to tak uměl:-).
Příloha: 20840_nahdat3.zip (16kB, staženo 24x)
citovat20840_nahdat3.zip (16kB, staženo 24x)tak, excel 97-2003 nezná fci EOMONTH, tedy poslední den příslušného měsíce. Vytvořil jsem ji jinak, takže tím by mělo být odstraněno to že nefunguje při změně měsíce. použito ve vzorcích A2:A32.
31 už to taky zvolí, jen jsem upravil rozsah generovaných náhodných čísel.
31 už to taky zvolí, jen jsem upravil rozsah generovaných náhodných čísel.
Příloha: 20845_nahdat4.zip (14kB, staženo 61x)
citovat20845_nahdat4.zip (14kB, staženo 61x)Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články