Forum strony www.multipasko.pl [Regulamin]


Dodaj wpis w tym temacie
Spis tematów
Login:

Hasło:
Strona: 1 2 ... 152 153 154 ... 554 555
Wyślij wiadomość do admina

Przewiń wpisy ↓

moje ... oprogramowanie

2017-11-08 (17:23)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22656

1386
wpis nr 1 122 091
[ CZCIONKA MONOSPACE ]

kleszek> możliwe że .....buforuje kolejne linie systemu pełnego ,pokrętnie przeskakując

coś w rodzaju brute force tylko ..... na skróty.



Do wieczora,bo teraz ...przerwa.

2017-11-08 (19:48)

status MLRandom
Data rejestracji: 2016-01-16
Ilość postów: 553

14699
wpis nr 1 122 138
[ CZCIONKA MONOSPACE ]

O żesz, 777ch, ale ta Twoja maszynka miele... miód malina. Jestem pod wrażeniem.... Mistrzu
2017-11-08 (22:48)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22656

1386
wpis nr 1 122 206
[ CZCIONKA MONOSPACE ]

MLRandom > a dziękuję ,

no..... zawsze można lepiej...szybciej...lepiej..szybciej...



jak zapewne wiesz ,

prawie wszystko w życiu zależy od ... przypadku ,





wpadłem rzucić okiem na ... cyferki

.... nie było najgorzej

dobrej nocki .



pozdrawiam
2017-11-09 (13:10)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22656

1386
wpis nr 1 122 265
[ CZCIONKA MONOSPACE ]

Jeśli na belce żółtej nie ma dodane > New

to procedura może mieć błąd ..... nie dam rady wszystkiego teraz sprawdzić

na razie usuwam program ,jak znajdę czas... to sprawdzę

i poprawię ,a wtedy wstawię.
2017-11-09 (13:23)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22656

1386
wpis nr 1 122 269
[ CZCIONKA MONOSPACE ]

Wieczorem dziś,lub jutro.....

zrobię tak ,że sprawdzone algorytmy dopuszczę

a te do poprawki zablokuje,

aby liczydło liczyło tylko to co ...... prawidłowo pokazuje gwarancję,

resztę na amen zablokuję .

2017-11-09 (15:16)

status fair_play
Data rejestracji: 2016-05-12
Ilość postów: 8687

14865
wpis nr 1 122 306
[ CZCIONKA MONOSPACE ]

777ch>



http://uploadfile.pl/pokaz/1264024---gfrp.html



"Plik nie istnieje"
2017-11-09 (15:43)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22656

1386
wpis nr 1 122 315
[ CZCIONKA MONOSPACE ]

pisałem wpis nr 1 122 265



że usuwam.....









jak poprawię gwarancje dla 2,3,4,5,6 to wstawię





post z linkiem usunięty





będzie dla t= [2] max v=80 m=k= limit<=20

będzie dla t= [3] max v=80 m=k= limit<=20

będzie dla t= [4] max v=80 m=k= limit<=20



będzie dla t= [5] max v=42 m=k= limit<=20

będzie dla t= [6] max v=30 m=k= limit<=20



a reszta do kosza.......

i nie od razu bo sporo poprawek,celem przyspieszenia....

--- wpis edytowano 2017-11-09 15:49 ---

2017-11-09 (20:03)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22656

1386
wpis nr 1 122 365
[ CZCIONKA MONOSPACE ]

-- Guarantee --

Gw. T=2

if M= 2~10 ....dla...... k= 2~20

nowe .....zrobione

---------------------------------

jutro ,jak dam radę ....

-- Guarantee --

Gw. T=3 ....dla...... k= 3~20

if M= 3~10
2017-11-09 (20:11)

status fair_play
Data rejestracji: 2016-05-12
Ilość postów: 8687

14865
wpis nr 1 122 373
[ CZCIONKA MONOSPACE ]

777ch>



Przydałby się w Jamperze przycisk "Break"

--- wpis edytowano 2017-11-09 20:13 ---

2017-11-09 (22:24)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22656

1386
wpis nr 1 122 436
[ CZCIONKA MONOSPACE ]

fair_play > klikasz w check box stop



tylko w trakcie sprawdzania gwarancji nie przerwie ,

więc trzeba próbować ....
2017-11-09 (23:28)

status fair_play
Data rejestracji: 2016-05-12
Ilość postów: 8687

14865
wpis nr 1 122 456
[ CZCIONKA MONOSPACE ]

777ch>



Kiedy właśnie o to chodzi żeby przerwać w trakcie
2017-11-11 (17:34)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22656

1386
wpis nr 1 122 854
[ CZCIONKA MONOSPACE ]

fair_play > to nie stosunek

-------------------------------------------

na razie nie miałem czasu ,więc nic nie piszę, martwi mnie natomiast

przydatność tych rozpisów,z paroma wyjątkami ,

bo jeśli złożymy np 12-ki z 40 liczb,to całkiem ładnie

w Multi łapią trafienia od 6 do nawet 9|12



ale skreślić możemy tylko 10 na kuponie ,a już rozpis 12-ek na dziesiątki

nie wchodzi w grę,jednym słowem ...... rządzi przypadek......

a więc programy są "zasadniczo" ..... nieprzydatne.



pozdrawiam
2017-11-11 (18:24)

status fair_play
Data rejestracji: 2016-05-12
Ilość postów: 8687

14865
wpis nr 1 122 864
[ CZCIONKA MONOSPACE ]

777ch>



Mam pewien pomysł na algorytm liczenia gwarancji, który wydaje mi się dość szybki

Dla przykładu gwarancję rozpisu z wpisu 1 120 805 dla systemu C(42,20,4,5) = 20,

Gwarancja: 99,557%

Braki: 3772

liczy w ciągu 27 sekund.

Jeśli taki czas obliczeń na mojej starotce Intela w porównaniu z Twoim expresem i7 jest konkurencyjny to podzielę się swoim pomysłem.



Pozdrawiam
2017-11-11 (20:03)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22656

1386
wpis nr 1 122 882
[ CZCIONKA MONOSPACE ]

fair_play



Bardzo dziękuję za tę chęc podzielenia się pomysłem na algorytm,

aby jednak sprawdzać gwarancję w locie,

zmieniając liczby w tablicach ,potrzebny czas sprawdzania musi być niezwykle szybki,

ten wynosi



Dla przykładu gwarancję rozpisu z wpisu 1 120 805 dla systemu C(42,20,4,5) = 20,

Gwarancja: 99,557%

Braki: 3772

oblicza w ciągu 10~~13 milisekund na moim i7.... już wysłużonym





edit

nie żartuję ,to zależy oczywiście od aktualnego stanu pokrycia czwórek,

na początku w tablicach nie ma dużo pokrytych,im pokrytych jest więcej tym czas sprawdzania gwarancji się...skraca.......



przy starcie ,dla wygenerowanych randomizerem 20-kombinacjach ,startujemy od 20~26 milisekund

--- wpis edytowano 2017-11-11 20:07 ---

2017-11-11 (20:21)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22656

1386
wpis nr 1 122 888
[ CZCIONKA MONOSPACE ]

Czas obliczeń wyniósł 4,23 sec.

tyle zajęło excelcowi sprawdzenie pokrycia 4-ek

w takiej układance

1 2 3 4 5 6 7 8 9 10 11 12 13 16 18 21 24 27 29 33

1 2 3 4 5 6 7 8 9 10 11 12 13 17 18 23 28 32 35 41

1 2 3 4 5 6 7 8 9 10 11 12 13 14 17 18 23 24 30 38

1 2 3 4 5 6 7 8 9 10 11 12 13 14 23 24 31 34 40 42

1 2 3 4 5 6 7 8 9 10 11 12 13 15 18 24 30 32 33 39

1 2 3 4 5 6 7 8 9 10 11 12 13 16 17 24 34 36 37 42

1 2 3 4 5 6 7 8 9 10 11 12 13 17 18 19 21 29 30 35

1 2 3 4 5 6 7 8 9 10 11 12 13 14 16 18 19 21 32 38

1 2 3 4 5 6 7 8 9 10 11 12 13 14 20 22 23 25 36 41

1 2 3 4 5 6 7 8 9 10 11 12 13 15 17 21 22 32 39 40

1 2 3 4 5 6 7 8 9 10 11 12 13 15 25 29 31 32 35 36

1 2 3 4 5 6 7 8 9 10 11 12 13 16 20 23 28 30 38 39

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 18 27 29 41

1 2 3 4 5 6 7 8 9 10 11 12 13 14 17 25 27 37 38 41

1 2 3 4 5 6 7 8 9 10 11 12 13 15 16 17 19 31 35 42

1 2 3 4 5 6 7 8 9 10 11 12 13 15 19 27 33 35 37 41

1 2 3 4 5 6 7 8 9 10 11 12 13 16 18 24 25 27 30 35

1 2 3 4 5 6 7 8 9 10 11 12 13 17 18 32 35 37 41 42



masz poniżej to czym sprawdzałem







Sub system_pokrycie_czwórek()

'

' Makro2 Makro

' Makro zarejestrowane 2013-02-11, autor Admin



' DANE WYNIKÓW LOSOWAŃ

Dim tablicasystem() As Variant

Dim dł As Byte

Dim vlos As Long

Dim stoper As Date, czas As String

Dim n1, n2, n3, n4, n5 As Byte

Dim los1, liczba, vlos1

Dim tabgps As Variant



dł = Application.WorksheetFunction.CountA(Range(Cells(1, 1), Cells(1, 20)))



vlos = Application.WorksheetFunction.CountA(Range("A1:A65536"))

If vlos = 0 Then MsgBox "Wpisz jskiś system w wiersze pomiędzy kolumnami [A] do [T]"

If vlos = 0 Then Exit Sub

tablicasystem = Range(Cells(1, 1), Cells(vlos, dł)).Value

'Range("ad3:ad5") = ""

stoper = Timer











Dim lp, zer

Dim los As Long

Dim n As Byte

Dim k As Byte

Dim lw1, lw2, lw3, lw4, lw5

Dim csnmax As Long

Dim kombmax As Long

Dim pozycja As Long

Dim ka

Dim en

Dim xx As Long

Dim csnpusty As Long

Dim tabliczb As Variant

n = Application.WorksheetFunction.max(Range(Cells(1, 1), Cells(vlos, 20)))

k = 4

If k > dł Then MsgBox "System nie zawiera czwórek"

If k > dł Then Exit Sub

Dim Lba As Byte

Dim Elem As Byte

Lba = k

Elem = n

csnmax = SILNIA(n) / (SILNIA(k) * SILNIA(n - k))

kombmax = Round(SILNIA(Elem) / (SILNIA(Lba) * SILNIA(Elem - Lba)))

ka = k

en = n



ReDim tabcsn(kombmax - 1, 0)





For csnpusty = 1 To csnmax

tabcsn(csnpusty - 1, 0) = 0

Next csnpusty



For los = vlos To 1 Step -1





For n1 = 1 To dł - 3

For n2 = n1 + 1 To dł - 2

For n3 = n2 + 1 To dł - 1

For n4 = n3 + 1 To dł





ReDim tabliczb(0, 3)

tabliczb(0, 0) = tablicasystem(los, n1)

tabliczb(0, 1) = tablicasystem(los, n2)

tabliczb(0, 2) = tablicasystem(los, n3)

tabliczb(0, 3) = tablicasystem(los, n4)









pozycja = kombmax

For xx = ka To 1 Step -1

If (en - tabliczb(0, xx - 1)) > (ka - xx) Then pozycja = pozycja - KOMBINACJE((ka + 1) - xx, en - tabliczb(0, xx - 1))



Next xx





tabcsn(pozycja - 1, 0) = pozycja





Next n4

Next n3

Next n2

Next n1



Next los







zer = 0



lp = 0

For lw1 = 1 To n - 3

For lw2 = lw1 + 1 To n - 2

For lw3 = lw2 + 1 To n - 1

For lw4 = lw3 + 1 To n



lp = lp + 1



If tabcsn(lp - 1, 0) = 0 Then GoTo 1

zer = zer + 1





1



Next lw4

Next lw3

Next lw2

Next lw1













czas = Format(Timer - stoper, " 00:00:00.00") & " sec."



Cells(3, 30) = "Wszystkich 4-ek = " & csnmax

Cells(4, 30) = "Pokrytych czwórek = " & zer

Cells(4, 31) = zer

Cells(3, 30) = "Czas obliczeń wyniósł " & czas

Cells(5, 30) = "W systemie brak [" & csnmax - zer & "]-kombinacji"

'Cells(5, 30) = ((zer) / csnmax)

Cells(4, 31).Select

End Sub









Function SILNIA(n As Byte)



SILNIA = 1

If n < 2 Then SILNIA = 1 Else: SILNIA = SILNIA(n - 1) * n



End Function





'Funkcja KOMBINACJE oblicza [ilość kombinacji] bez powtórek.



Function KOMBINACJE(Lba As Byte, Elem As Byte)





KOMBINACJE = Round(SILNIA(Elem) / (SILNIA(Lba) * SILNIA(Elem - Lba)))

End Function



' Funkcja NUMER_KOMBINACJI zwraca [numer kombinacji] odpowiadający

' kolejnym liczbom.

' Liczby zawarte są w tabeli ( ).

' ka - ilość liczb, tu podstaw 6.

' en - ilość elementów, tu podstaw 49.



Function NUMER_KOMBINACJI(ka, en As Byte)

Dim liczba As Byte

Dim xx As Integer

Dim pozycja As Long

Dim ka As Byte '- ilość liczb, tu podstaw 6.

Dim en As Byte '- ilość elementów, tu podstaw 49.

ka = k

en = n

pozycja = KOMBINACJE(ka, en)

For xx = ka To 1 Step -1

If (en - tabliczb(xx)) > (ka - xx) Then pozycja = pozycja - KOMBINACJE((ka + 1) - xx, en - tabliczb(xx))



Next xx

NUMER_KOMBINACJI = pozycja



End Function



--- wpis edytowano 2017-11-11 20:23 ---

2017-11-11 (20:34)

status kleszek
Data rejestracji: 2006-05-27
Ilość postów: 4979

2047
wpis nr 1 122 892
[ CZCIONKA MONOSPACE ]

Na moim lekko podrasowanym Intel Core i7 CPU 860 @ 2.8 GHz czas obliczeń wyniósł 00:00:03,67 sec. Aż nie chce mi się wierzyć, że czas obliczeń miałem krótszy niż 777ch.

2017-11-11 (20:38)

status fair_play
Data rejestracji: 2016-05-12
Ilość postów: 8687

14865
wpis nr 1 122 894
[ CZCIONKA MONOSPACE ]

777ch >

Dziękuję za przykład.

Sprawdzę po meczu ile to zajmie mojemu expresowi

2017-11-11 (21:33)

status MLRandom
Data rejestracji: 2016-01-16
Ilość postów: 553

14699
wpis nr 1 122 904
[ CZCIONKA MONOSPACE ]

777ch, rozumiem, że to tylko przykładowe makro, nie podające faktycznych gwarancji?

Z ciekawości sprawdziłem go na systemie 169 zakładowym i otrzymałem inne wyniki niż te podane przez MATIDA. To samo miałem z przeróbką tego makra na trójki.

To wersja roboczo-przykładowa?

Ale faktycznie - jest zajebiście szybkie GRATULACJE!
2017-11-11 (21:55)

status MLRandom
Data rejestracji: 2016-01-16
Ilość postów: 553

14699
wpis nr 1 122 911
[ CZCIONKA MONOSPACE ]

777ch, rzuć okiem, czy tu jest wszytko OK:



pozycja = kombmax

For xx = ka To 1 Step -1

If (en - tabliczb(0, xx - 1)) > (ka - xx) Then pozycja = pozycja - KOMBINACJE((ka + 1) - xx, en - tabliczb(0, xx - 1))



Next xx





tabcsn(pozycja - 1, 0) = pozycja



To "silnik" makra, więc jeśli tu wszystko OK, to szukam gdzie indziej. Przyznaje, iż "rozbebeszyć na bity" te kilka linijek, a głównie jedną, to nie jest minutka
2017-11-11 (23:10)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22656

1386
wpis nr 1 122 923
[ CZCIONKA MONOSPACE ]

dla trójek



Sub system_pokrycie_trójek()

'

' Makro2 Makro

' Makro zarejestrowane 2013-02-11, autor Admin



' DANE WYNIKÓW LOSOWAŃ

Dim tablicasystem() As Variant

Dim dł As Byte

Dim vlos As Long

Dim stoper As Date, czas As String

Dim n1, n2, n3, n4, n5 As Byte

Dim los1, liczba, vlos1

Dim tabgps As Variant



dł = Application.WorksheetFunction.CountA(Range(Cells(1, 1), Cells(1, 7))) 'tu zmień range dla ilu skreśleń



vlos = Application.WorksheetFunction.CountA(Range("A1:A65536"))

If vlos = 0 Then MsgBox "Wpisz jskiś system w wiersze pomiędzy kolumnami [A] do [T]"

If vlos = 0 Then Exit Sub

tablicasystem = Range(Cells(1, 1), Cells(vlos, dł)).Value

Range("ad7:ad11") = ""

stoper = Timer











Dim lp, zer

Dim los As Long

Dim n As Byte

Dim k As Byte

Dim lw1, lw2, lw3, lw4, lw5

Dim csnmax As Long

Dim kombmax As Long

Dim pozycja As Long

Dim ka

Dim en

Dim xx As Long

Dim csnpusty As Long

Dim tabliczb As Variant

n = Application.WorksheetFunction.max(Range(Cells(1, 1), Cells(vlos, 7))) 'tu zmień range dla ilu skreśleń

k = 3

If k > dł Then MsgBox "System nie zawiera trójek"

If k > dł Then Exit Sub

Dim Lba As Byte

Dim Elem As Byte

Lba = k

Elem = n

csnmax = SILNIA(n) / (SILNIA(k) * SILNIA(n - k))

kombmax = Round(SILNIA(Elem) / (SILNIA(Lba) * SILNIA(Elem - Lba)))

ka = k

en = n



ReDim tabcsn(kombmax - 1, 0)





For csnpusty = 1 To csnmax

tabcsn(csnpusty - 1, 0) = 0

Next csnpusty



For los = vlos To 1 Step -1





For n1 = 1 To dł - 2

For n2 = n1 + 1 To dł - 1

For n3 = n2 + 1 To dł







ReDim tabliczb(0, 2)

tabliczb(0, 0) = tablicasystem(los, n1)

tabliczb(0, 1) = tablicasystem(los, n2)

tabliczb(0, 2) = tablicasystem(los, n3)











pozycja = kombmax

For xx = ka To 1 Step -1

If (en - tabliczb(0, xx - 1)) > (ka - xx) Then pozycja = pozycja - KOMBINACJE((ka + 1) - xx, en - tabliczb(0, xx - 1))



Next xx





tabcsn(pozycja - 1, 0) = pozycja







Next n3

Next n2

Next n1



Next los







zer = 0



lp = 0

For lw1 = 1 To n - 2

For lw2 = lw1 + 1 To n - 1

For lw3 = lw2 + 1 To n





lp = lp + 1



If tabcsn(lp - 1, 0) = 0 Then GoTo 1

zer = zer + 1





1





Next lw3

Next lw2

Next lw1













czas = Format(Timer - stoper, " 00:00:00.00") & " sec."



Cells(7, 30) = "Wszystkich 3-ek = " & csnmax

Cells(8, 30) = "Pokrytych trójek = " & zer

Cells(8, 31) = zer

Cells(9, 30) = "Czas obliczeń wyniósł " & czas

Cells(10, 30) = "W systemie brak [" & csnmax - zer & "]-kombinacji"

Cells(11, 30) = ((zer) / csnmax)

End Sub





Sub system_pokrycie_par()

'

' Makro2 Makro

' Makro zarejestrowane 2013-02-11, autor Admin



' DANE WYNIKÓW LOSOWAŃ

Dim tablicasystem() As Variant

Dim dł As Byte

Dim vlos As Long

Dim stoper As Date, czas As String

Dim n1, n2, n3, n4, n5 As Byte

Dim los1, liczba, vlos1

Dim tabgps As Variant



dł = Application.WorksheetFunction.CountA(Range(Cells(1, 1), Cells(1, 7)))



vlos = Application.WorksheetFunction.CountA(Range("A1:A65536"))

If vlos = 0 Then MsgBox "Wpisz jskiś system w wiersze pomiędzy kolumnami [A] do [T]"

If vlos = 0 Then Exit Sub

tablicasystem = Range(Cells(1, 1), Cells(vlos, dł)).Value

Range("ad12:ad16") = ""

stoper = Timer











Dim lp, zer

Dim los As Long

Dim n As Byte

Dim k As Byte

Dim lw1, lw2, lw3, lw4, lw5

Dim csnmax As Long

Dim kombmax As Long

Dim pozycja As Long

Dim ka

Dim en

Dim xx As Long

Dim csnpusty As Long

Dim tabliczb As Variant

n = Application.WorksheetFunction.max(Range(Cells(1, 1), Cells(vlos, 7)))

k = 2

If k > dł Then MsgBox "System nie zawiera par"

If k > dł Then Exit Sub

Dim Lba As Byte

Dim Elem As Byte

Lba = k

Elem = n

csnmax = SILNIA(n) / (SILNIA(k) * SILNIA(n - k))

kombmax = Round(SILNIA(Elem) / (SILNIA(Lba) * SILNIA(Elem - Lba)))

ka = k

en = n



ReDim tabcsn(kombmax - 1, 0)





For csnpusty = 1 To csnmax

tabcsn(csnpusty - 1, 0) = 0

Next csnpusty



For los = vlos To 1 Step -1





For n1 = 1 To dł - 1

For n2 = n1 + 1 To dł









ReDim tabliczb(0, 1)

tabliczb(0, 0) = tablicasystem(los, n1)

tabliczb(0, 1) = tablicasystem(los, n2)













pozycja = kombmax

For xx = ka To 1 Step -1

If (en - tabliczb(0, xx - 1)) > (ka - xx) Then pozycja = pozycja - KOMBINACJE((ka + 1) - xx, en - tabliczb(0, xx - 1))



Next xx





tabcsn(pozycja - 1, 0) = pozycja







Next n2

Next n1



Next los







zer = 0



lp = 0

For lw1 = 1 To n - 1

For lw2 = lw1 + 1 To n







lp = lp + 1



If tabcsn(lp - 1, 0) = 0 Then GoTo 1

zer = zer + 1





1







Next lw2

Next lw1













czas = Format(Timer - stoper, " 00:00:00.00") & " sec."



Cells(12, 30) = "Wszystkich 2-ek = " & csnmax

Cells(13, 30) = "Pokrytych par = " & zer

Cells(13, 31) = zer

Cells(14, 30) = "Czas obliczeń wyniósł " & czas

Cells(15, 30) = "W systemie brak [" & csnmax - zer & "]-kombinacji"

Cells(16, 30) = ((zer) / csnmax)

End Sub







Sub system_pokrycie_piątek()

'

' Makro2 Makro

' Makro zarejestrowane 2013-02-11, autor Admin



' DANE WYNIKÓW LOSOWAŃ

Dim tablicasystem() As Variant

Dim dł As Byte

Dim vlos As Long

Dim stoper As Date, czas As String

Dim n1, n2, n3, n4, n5 As Byte

Dim los1, liczba, vlos1

Dim tabgps As Variant



dł = Application.WorksheetFunction.CountA(Range(Cells(1, 1), Cells(1, 7)))



vlos = Application.WorksheetFunction.CountA(Range("A1:A65536"))

If vlos = 0 Then MsgBox "Wpisz jskiś system w wiersze pomiędzy kolumnami [A] do [T]"

If vlos = 0 Then Exit Sub

tablicasystem = Range(Cells(1, 1), Cells(vlos, dł)).Value

Range("ad18:ad22") = ""

stoper = Timer











Dim lp, zer

Dim los As Long

Dim n As Byte

Dim k As Byte

Dim lw1, lw2, lw3, lw4, lw5

Dim csnmax As Long

Dim kombmax As Long

Dim pozycja As Long

Dim ka

Dim en

Dim xx As Long

Dim csnpusty As Long

Dim tabliczb As Variant

n = Application.WorksheetFunction.max(Range(Cells(1, 1), Cells(vlos, 7)))



k = 5



If k > dł Then MsgBox "System nie zawiera piątek"

If k > dł Then Exit Sub

Dim Lba As Byte

Dim Elem As Byte

Lba = k

Elem = n

csnmax = SILNIA(n) / (SILNIA(k) * SILNIA(n - k))

kombmax = Round(SILNIA(Elem) / (SILNIA(Lba) * SILNIA(Elem - Lba)))

ka = k

en = n



ReDim tabcsn(kombmax - 1, 0)





For csnpusty = 1 To csnmax

tabcsn(csnpusty - 1, 0) = 0

Next csnpusty



For los = vlos To 1 Step -1





For n1 = 1 To dł - 4

For n2 = n1 + 1 To dł - 3

For n3 = n2 + 1 To dł - 2

For n4 = n3 + 1 To dł - 1

For n5 = n4 + 1 To dł



ReDim tabliczb(0, 4)

tabliczb(0, 0) = tablicasystem(los, n1)

tabliczb(0, 1) = tablicasystem(los, n2)

tabliczb(0, 2) = tablicasystem(los, n3)

tabliczb(0, 3) = tablicasystem(los, n4)

tabliczb(0, 4) = tablicasystem(los, n5)







pozycja = kombmax

For xx = ka To 1 Step -1

If (en - tabliczb(0, xx - 1)) > (ka - xx) Then pozycja = pozycja - KOMBINACJE((ka + 1) - xx, en - tabliczb(0, xx - 1))



Next xx





tabcsn(pozycja - 1, 0) = pozycja



Next n5

Next n4

Next n3

Next n2

Next n1



Next los







zer = 0



lp = 0

For lw1 = 1 To n - 4

For lw2 = lw1 + 1 To n - 3

For lw3 = lw2 + 1 To n - 2

For lw4 = lw3 + 1 To n - 1

For lw5 = lw4 + 1 To n

lp = lp + 1



If tabcsn(lp - 1, 0) = 0 Then GoTo 1

zer = zer + 1





1

Next lw5

Next lw4

Next lw3

Next lw2

Next lw1













czas = Format(Timer - stoper, " 00:00:00.00") & " sec."



Cells(18, 30) = "Wszystkich 5-ek = " & csnmax

Cells(19, 30) = "Pokrytych piątek = " & zer

Cells(19, 31) = zer

Cells(20, 30) = "Czas obliczeń wyniósł " & czas

Cells(21, 30) = "W systemie brak [" & csnmax - zer & "]-kombinacji"

Cells(22, 30) = ((zer) / csnmax)

End Sub











mając takie wzorce ,sobie dla szóstek na pewno zrobicie



ale to stare ,dawne . ale pomocne rozwiązania,

================================================





nie mniej Jamper robi to

czyli sprawdza :19 zakładów ,20 liczb, v=42

3 if 3 w ok 0,20~~0,30 milisekundy

4 if 4 w pomiędzy 1,71 do 4 milisekundy

4 if 5 w ok 10~~20 milisekundy

5 if 5 w ok 27~30 milisekundy



ale już 5 if 10 dla 20 z 42 prawie 5 sekund .....niestety





| Dodaj wpis w tym temacie | Spis tematów | Wyniki lottoStrona: 1 2 ... 152 153 154 ... 554 555
Wyślij wiadomość do admina