Dodaj wpis w tym temacie
Spis tematów | Strona: 1 2 3 4 5 6 Wyślij wiadomość do admina |
Przewiń wpisy ↓ | ZAPŁACĘ ZA NAPISANIE PROGRAMU |
2014-08-24 (17:07) geniu7 Data rejestracji: 2011-08-16 Ilość postów: 795 | wpis nr 828 688 [ CZCIONKA SPECJALNA ] Ok, trochę się nie zrozumieliśmy, ale to nic. Jest OK. |
2014-08-24 (17:07) slawek001 Data rejestracji: 2005-02-24 Ilość postów: 6116 | wpis nr 828 689 [ CZCIONKA SPECJALNA ] 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) 777ch Data rejestracji: 2005-11-07 Ilość postów: 21425 | wpis nr 828 702 [ CZCIONKA SPECJALNA ] 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) slawek001 Data rejestracji: 2005-02-24 Ilość postów: 6116 | wpis nr 828 706 [ CZCIONKA SPECJALNA ] 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) slawek001 Data rejestracji: 2005-02-24 Ilość postów: 6116 | wpis nr 828 785 [ CZCIONKA SPECJALNA ] 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) slawek001 Data rejestracji: 2005-02-24 Ilość postów: 6116 | wpis nr 828 831 [ CZCIONKA SPECJALNA ] 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) slawek001 Data rejestracji: 2005-02-24 Ilość postów: 6116 | wpis nr 828 840 [ CZCIONKA SPECJALNA ] fala na moim przykładzie trwa 15 losowań a nie 18 jak podawałem wcześniej |
2014-08-25 (14:15) merti Data rejestracji: 2011-12-25 Ilość postów: 4460 | wpis nr 828 867 [ CZCIONKA SPECJALNA ] >Sławku, dostałeś maila? Jeśli nie to jaki masz teraz aktualnie? |
2014-08-26 (09:06) slawek001 Data rejestracji: 2005-02-24 Ilość postów: 6116 | wpis nr 829 059 [ CZCIONKA SPECJALNA ] 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) slawek001 Data rejestracji: 2005-02-24 Ilość postów: 6116 | wpis nr 829 060 [ CZCIONKA SPECJALNA ] w tłumie spamu maila nie widziałem adres cały czas ten sam ..... slawomir.hofman@interia.pl |
2014-08-26 (09:28) slawek001 Data rejestracji: 2005-02-24 Ilość postów: 6116 | wpis nr 829 069 [ CZCIONKA SPECJALNA ] 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) slawek001 Data rejestracji: 2005-02-24 Ilość postów: 6116 | wpis nr 829 109 [ CZCIONKA SPECJALNA ] 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) slawek001 Data rejestracji: 2005-02-24 Ilość postów: 6116 | wpis nr 829 297 [ CZCIONKA SPECJALNA ] 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) slawek001 Data rejestracji: 2005-02-24 Ilość postów: 6116 | wpis nr 829 326 [ CZCIONKA SPECJALNA ] 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 lotto | Strona: 1 2 3 4 5 6 Wyślij wiadomość do admina |