Forum strony www.multipasko.pl [Regulamin]


Dodaj wpis w tym temacie
Spis tematów
Login:

Hasło:
Strona: 1 2 3 4 5 6
Wyślij wiadomość do admina

Przewiń wpisy ↓

ZAPŁACĘ ZA NAPISANIE PROGRAMU

2014-08-24 (17:07)

status geniu7
Data rejestracji: 2011-08-16
Ilość postów: 795

13148
wpis nr 828 688
[ CZCIONKA MONOSPACE ]

Ok, trochę się nie zrozumieliśmy, ale to nic. Jest OK.
2014-08-24 (17:07)

status slawek001
Data rejestracji: 2005-02-24
Ilość postów: 6116

721
wpis nr 828 689
[ CZCIONKA MONOSPACE ]

Orginalne Makro Dylonga .... pobierało ostatnie 50 losowań wystarczyło zmienić adres pobierania i każde losowanie można było ściągnąć ze strony Paska .... teraz trzeba w nim zmienić numer tabeli z której pobierane są losowania ale dla mnie to czarna magia



Option Explicit

Option Base 1

Sub Wyniki_losowan_ML()

Dim adres_url As String, sort_url As String, nazwa As String

Dim ostatnie As Integer, max_w_bazie As Integer, brakujacych As Integer

Dim tab_pasko As Variant, tab_ml As Variant, pom_data As Variant, pom_wynik As Variant

Dim i As Integer, j As Integer, k As Integer, l As Integer, krokow As Integer, url_start As Integer

Dim wb As Workbook

Application.ScreenUpdating = False

Arkusz1.Activate

Set wb = ActiveWorkbook

nazwa = wb.ActiveSheet.Name

Sheets(nazwa).Activate

max_w_bazie = Application.WorksheetFunction.Max(Range("A:A"))

Sheets(nazwa).Range("CW:CY").ClearContents

adres_url = "URL;http://www.multipasko.pl/wyniki-lotto/multi-lotek/"

Application.ScreenUpdating = False

With ActiveSheet.QueryTables.Add(Connection:= _

adres_url, Destination:=Range("CW1"))

.Name = "multi-lotek"

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.BackgroundQuery = True

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.WebSelectionType = xlSpecifiedTables

.WebFormatting = xlWebFormattingNone

.WebTables = "6"

.WebPreFormattedTextToColumns = True

.WebConsecutiveDelimitersAsOne = True

.WebSingleBlockTextImport = False

.WebDisableDateRecognition = False

.Refresh BackgroundQuery:=False

End With



Range("CW1:CY50").Select

Selection.Sort Key1:=Range("CW1"), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

ostatnie = Application.WorksheetFunction.Max(Range("CW:CW"))

brakujacych = ostatnie - max_w_bazie



Select Case brakujacych

Case 0

Exit Sub

Case Is <= 50

tab_pasko = Sheets(nazwa).Range(Cells(51 - brakujacych, 101), Cells(50, 103))

ReDim tab_ml(brakujacych, 22)

For i = 1 To brakujacych

tab_ml(i, 1) = tab_pasko(i, 1)

pom_data = Split(tab_pasko(i, 2), ".")

tab_ml(i, 2) = DateSerial(Val(pom_data(2)), Val(pom_data(1)), Val(pom_data(0)))

pom_wynik = Split(tab_pasko(i, 3), ",")

For k = 0 To 19

tab_ml(i, 3 + k) = Val(pom_wynik(k))

Next k

Next i

Sheets(nazwa).Range(Cells(max_w_bazie + 3, 1), Cells((max_w_bazie + 2) + brakujacych, 22)).Value = tab_ml



Case Is > 50

If brakujacych Mod 50 = 0 Then

krokow = brakujacych / 50

url_start = ostatnie - (krokow * 50) + 50

ElseIf ostatnie Mod 50 <> 0 Then

krokow = Int(brakujacych / 50) + 1

If brakujacych = ostatnie Then

url_start = brakujacych Mod 50

Else

url_start = ostatnie - (krokow * 50) + 50

End If

End If

sort_url = "URL;http://www.multipasko.pl/wyniki-lotto/multi-lotek/sortowane/"

For l = 1 To krokow

adres_url = sort_url & url_start & "/"

Sheets(nazwa).Range(Cells(1, 101), Cells(51, 103)).ClearContents

With ActiveSheet.QueryTables.Add(Connection:=adres_url, Destination:=Range("CW1"))

.Name = "multi-lotek"

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.BackgroundQuery = True

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.WebSelectionType = xlSpecifiedTables

.WebFormatting = xlWebFormattingNone

.WebTables = "6"

.WebPreFormattedTextToColumns = True

.WebConsecutiveDelimitersAsOne = True

.WebSingleBlockTextImport = False

.WebDisableDateRecognition = False

.Refresh BackgroundQuery:=False

End With

Range("CW1:CY50").Select

Selection.Sort Key1:=Range("CW1"), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

ostatnie = Application.WorksheetFunction.Max(Range("CW:CW"))

max_w_bazie = Application.WorksheetFunction.Max(Range("A:A"))

brakujacych = ostatnie - max_w_bazie

url_start = url_start + 50

If ostatnie >= 50 Then

tab_pasko = Sheets(nazwa).Range(Cells(51 - brakujacych, 101), Cells(50, 103))

Else

tab_pasko = Sheets(nazwa).Range(Cells(1, 101), Cells(ostatnie, 103))

End If

ReDim tab_ml(brakujacych, 22)

For i = 1 To brakujacych

tab_ml(i, 1) = tab_pasko(i, 1)

pom_data = Split(tab_pasko(i, 2), ".")

tab_ml(i, 2) = DateSerial(Val(pom_data(2)), Val(pom_data(1)), Val(pom_data(0)))

pom_wynik = Split(tab_pasko(i, 3), ",")

For k = 0 To 19

tab_ml(i, 3 + k) = Val(pom_wynik(k))

Next k

Next i

Sheets(nazwa).Range(Cells(max_w_bazie + 3, 1), Cells((max_w_bazie + 2) + brakujacych, 22)).Value = tab_ml

Next l

End Select

Application.ScreenUpdating = True

Sheets(nazwa).Range("CW:CY").ClearContents

Sheets(nazwa).Cells(ostatnie + 3, 1).Select

ActiveWorkbook.Save

End Sub



2014-08-24 (18:08)

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

1386
wpis nr 828 702
[ CZCIONKA MONOSPACE ]

Sławek , makro należy poprawić ,a najlepiej zrobić od nowa



ale początek jest prawidłowy , działa czyli pobiera te 50 , sprawdź .



Sub Wyniki_losowan_ML()

Dim adres_url As String, sort_url As String, nazwa As String

Dim ostatnie As Integer, max_w_bazie As Integer, brakujacych As Integer

Dim tab_pasko As Variant, tab_ml As Variant, pom_data As Variant, pom_wynik As Variant

Dim i As Integer, j As Integer, k As Integer, l As Integer, krokow As Integer, url_start As Integer

Dim wb As Workbook

Application.ScreenUpdating = False

Arkusz1.Activate

Set wb = ActiveWorkbook

nazwa = wb.ActiveSheet.Name

Sheets(nazwa).Activate

max_w_bazie = Application.WorksheetFunction.Max(Range("A:A"))

Sheets(nazwa).Range("CW:CY").ClearContents

adres_url = "URL;http://www.multipasko.pl/wyniki-lotto/multi-lotek/"

Application.ScreenUpdating = False

With ActiveSheet.QueryTables.Add(Connection:= _

adres_url, Destination:=Range("CW1"))

.Name = "multi-lotek"

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.BackgroundQuery = True

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.WebSelectionType = xlSpecifiedTables

.WebFormatting = xlWebFormattingNone

.WebTables = "3"

.WebPreFormattedTextToColumns = True

.WebConsecutiveDelimitersAsOne = True

.WebSingleBlockTextImport = False

.WebDisableDateRecognition = False

.Refresh BackgroundQuery:=False

End With

MsgBox Application.WorksheetFunction.CountA(Range("Cy:Cy"))

End Sub

2014-08-24 (19:04)

status slawek001
Data rejestracji: 2005-02-24
Ilość postów: 6116

721
wpis nr 828 706
[ CZCIONKA MONOSPACE ]

Leszek tak dla ciekawości podałem Makro jakie Dylong wykonał na bazie tego co "wyprodukowałem" w arkuszu .... już się przyzwyczaiłem Kwarendą pobierać wyniki losowań i przy tym sposobie pozostaje ..... i tak jestem teraz na etapie wykonania szablonu który podawać będzie po ilu losowaniach wyszła 80 liczba, dość ciekawe wychodzą układy graficzne wiec będę miał co mącić w tym temacie
2014-08-25 (00:02)

status slawek001
Data rejestracji: 2005-02-24
Ilość postów: 6116

721
wpis nr 828 785
[ CZCIONKA MONOSPACE ]

W oczekiwaniu na wyjście pełnych 80 liczb trzeba było czekać 15 losowań







zmienną jest tutaj suma losowań na losowanie 8217 wynosi 15 losowań na losowanie 8218 będzie już inna ..... mam pytanie ..... jaką formułę można zastosować żeby podała ile razy wystąpiła dana liczba we wskazanej sumie losowań .... z tym że suma losowań jest zmienna.
2014-08-25 (10:28)

status slawek001
Data rejestracji: 2005-02-24
Ilość postów: 6116

721
wpis nr 828 831
[ CZCIONKA MONOSPACE ]

suma losowań kiedy wyszło 80 liczb może pokazywać jak długo trwała "fala" i kiedy nastąpiła jej zmiana ...... zachodzi płynność w zmianie ilości losowań kiedy wychodzi 80 liczb.







jest to część analizy ostatnia suma losowań 32 płynnie przechodzi to 14 losowań jest to najdłuższa fala w moim przedziale losowań która trwała 18 losowań.
2014-08-25 (11:36)

status slawek001
Data rejestracji: 2005-02-24
Ilość postów: 6116

721
wpis nr 828 840
[ CZCIONKA MONOSPACE ]

fala na moim przykładzie trwa 15 losowań a nie 18 jak podawałem wcześniej



2014-08-25 (14:15)

status merti
Data rejestracji: 2011-12-25
Ilość postów: 4460

13301
wpis nr 828 867
[ CZCIONKA MONOSPACE ]

>Sławku, dostałeś maila? Jeśli nie to jaki masz teraz aktualnie?
2014-08-26 (09:06)

status slawek001
Data rejestracji: 2005-02-24
Ilość postów: 6116

721
wpis nr 829 059
[ CZCIONKA MONOSPACE ]

dopiero rozbudzam się, mam inny system pracy niż "Normalni" Ludzie ..... Właśnie liczyłem na Ciebie pamiętam jak skróconą formułę mi podałeś tego co ja obrazkowo wykonuje.

2014-08-26 (09:09)

status slawek001
Data rejestracji: 2005-02-24
Ilość postów: 6116

721
wpis nr 829 060
[ CZCIONKA MONOSPACE ]

w tłumie spamu maila nie widziałem adres cały czas ten sam ..... slawomir.hofman@interia.pl
2014-08-26 (09:28)

status slawek001
Data rejestracji: 2005-02-24
Ilość postów: 6116

721
wpis nr 829 069
[ CZCIONKA MONOSPACE ]

i tak jestem jeszcze na etapie, co nazywa się makro u mnie to twór makro podobny, ale robi co ja chce podaje po ilu losowaniach wyszła 80 liczba.







Jak widać od losowania 8219 powstaje następna "nowa" fala i moje analiza powinna od nowa się zaczynać od wyjść gdzie po 13 losowaniach wyszło 80 liczb.
2014-08-26 (11:58)

status slawek001
Data rejestracji: 2005-02-24
Ilość postów: 6116

721
wpis nr 829 109
[ CZCIONKA MONOSPACE ]

zrobiłem Marko "Auto_Open" .... ale to nie jest ta kolejność którą chce posiadać wpierw muszę Kwarendą pobrać bazę wyników losowań pózniej dopiero może uruchomić się Makro a mam odwrotnie wpierw Makro a póżniej Kwarenda jak wykonać prawidłową kolejność.
2014-08-27 (00:54)

status slawek001
Data rejestracji: 2005-02-24
Ilość postów: 6116

721
wpis nr 829 297
[ CZCIONKA MONOSPACE ]

dorwałem się do makra które zamieścił ... kleszek .... tylko jak je przerobić by pobierać ostatnie 200 losowań w tym samym miejscu



Sub aktualizuj()

Dim ost_k As Long, i As Long, ost_w As Long, ile As Long, X As Long

Dim wsk As Byte, pom As Byte

Dim Tabela As Variant



Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual



With Sheets("Arkusz1")

ost_k = .Cells(1, .Columns.Count).End(xlToLeft).Column

For i = ost_k To 1 Step -1

.Columns(i).Delete

Next i



With Sheets("Arkusz1").QueryTables.Add(Connection:="URL;http://www.multipasko.pl/wyniki-csv.php?f=multimulti", _

Destination:=Sheets("Arkusz1").Range("a1"))



.Name = "ml_1"

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.BackgroundQuery = True

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

'.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.WebSelectionType = xlAllTables

.WebFormatting = xlWebFormattingNone

.WebPreFormattedTextToColumns = True

.WebConsecutiveDelimitersAsOne = True

.WebSingleBlockTextImport = False

.WebDisableDateRecognition = False

.WebDisableRedirections = False

.Refresh BackgroundQuery:=False

.SaveData = True

End With



.Rows(1).Delete

ile = .Cells(Rows.Count, "A").End(xlUp).Row



Tabela = .Range("A1:A" & ile).Value

On Error GoTo koniec:

For i = 1 To ile

Tabela(i, 1) = Replace(Tabela(i, 1), ";", ". ", 1, 1)

Tabela(i, 1) = Replace(Tabela(i, 1), ";", ".", 1, 2)

Next i

On Error GoTo 0

.Range("A1:A" & ile).Value = Tabela



.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _

Semicolon:=True, Comma:=True, Space:=True, Other:=False, OtherChar:= _

".", FieldInfo:=Array(Array(1, 1), Array(2, 4), Array(3, 1), Array(4, 1), Array(5, 1), _

Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1) _

, Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array( _

19, 1), Array(20, 1), Array(21, 1), Array(22, 1)), TrailingMinusNumbers:=True

.Columns("A:A").Replace What:=".", Replacement:="", LookAt:=xlPart, _

SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

ReplaceFormat:=False

.Cells.EntireColumn.AutoFit



Erase Tabela

Tabela = .Range("C1:V" & ile).Value

ost_w = .Cells(.Rows.Count, 1).End(xlUp).Row

ost_k = .Cells(1, .Columns.Count).End(xlToLeft).Column



Range(.Cells(4424, 3), .Cells(ost_w, ost_k)).Copy

Sheets("Arkusz2").Range("AP1").PasteSpecial Paste:=xlPasteValues



For i = 1 To ile

Do

wsk = 0

For X = 1 To 20 - 1

If Tabela(i, X + 1) < Tabela(i, X) Then

wsk = 1

pom = Tabela(i, X)

Tabela(i, X) = Tabela(i, X + 1)

Tabela(i, X + 1) = pom

End If

Next X

Loop Until wsk = 0

Next i



.Range("C1:V" & ile).Value = Tabela





Range(.Cells(4424, 3), .Cells(ost_w, ost_k)).Copy

Sheets("Arkusz2").Range("D1").PasteSpecial Paste:=xlPasteValues

.Cells.QueryTable.Delete

End With



Erase Tabela



With Application

.ScreenUpdating = True

.Calculation = xlCalculationAutomatic

.CutCopyMode = False

End With



MsgBox "Aktualizacja zakończona."

Exit Sub



koniec:



With Application

.ScreenUpdating = True

.Calculation = xlCalculationAutomatic

.CutCopyMode = False

End With

Worksheets("Arkusz1").Cells.QueryTable.Delete

MsgBox "Aktualizacja obecnie niemożliwa", vbExclamation

ActiveSheet.Shapes("Button 1").Select

Selection.OnAction = "aktualizuj"

Range("AO11").Select

ActiveWorkbook.RunAutoMacros Which:=xlAutoClose

End Sub

2014-08-27 (10:09)

status slawek001
Data rejestracji: 2005-02-24
Ilość postów: 6116

721
wpis nr 829 326
[ CZCIONKA MONOSPACE ]

Fajna ciekawostka jeżeli w "fali" spadnie wartość liczby o 1 i fala nie ulega zmianie dalej trwa jest duże prawdopodobieństwo ze liczba wyjdzie następnego losowania



| Dodaj wpis w tym temacie | Spis tematów | Wyniki lottoStrona: 1 2 3 4 5 6
Wyślij wiadomość do admina