Copia dati web 2

[Statix]

credo di aver risolto il problema delle estrazioni +1 e -1,
modificato
dDate = dDate + dDay -1 con
dDate = dDate + dDay
e mettendo un giorno in più alla variabile G,

Codice: Seleziona tutto

Dim A, M, G As Integer
A = Range("X1")  'Anno
M = Range("X2")  'Mese
G = Range("X3") + 1' Giorno
Range("B2:I10000").ClearContents

Dest = "Foglio1" '<<<< Il Foglio dove sara' creato l'elenco
'
Sheets(Dest).Select
Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Select
On Error Resume Next
IE.Quit
Set IE = Nothing
On Error GoTo 0
Do
Call DataColl
DoEvents
If dDate < DateSerial(A, M, G) Then Exit Do '++++

[Statix]

niente da fare non va,
questa non va toccata altrimenti mi sballa la data di estrazione
dDate = dDate + dDay -1

[Statix]

Ciao a tutti e buona domenica,
stranamente non so cosa sia successo dapprima le ultime date si aggiornavano alternate o mancante
poi all'improvviso copia tutte le date senza più errori,ho aggiustato un po con le formule
anche le alternanze del LunchTime con il TeaTime,
manca solamente l'ordinamento dell'estrazione in ordine di uscita,
altrimenti tutto il lavoro fatto finora non è servito a nulla.

[Statix]

eccoci qua, la macro ricomincia di nuovo a fare scherzi,
quando lancio la macro
copia tutte le estrazioni,
riclicco di nuovo e mi copia tutte le estrazioni tranne l'ultima del 23/09/2017
riclicco di nuovo copia tutte le estrazioni ma con la data del 22/09/2017 mancante,
ricliccando ancora mi da sempre tutte le estrazioni senza errori
è un errore saltuario.

[Statix]

ho aumentato i tempi di attesa mywait , sembra andare bene, speriamo.

[Statix]

il problema persiste ,adesso non mi aggiorna l'ultima estrazione TeaTime del 24/09/2017,
eppure tutto il resto sta andando bene,
mi mancava solo il click dell'ordinamento.

[Anthony47]

Aspetta, mi avevi chiesto di mettere le estrazioni giornaliere su due righe diverse e ora le vedo affiancate?

A caso, ma cercando di indirizzare tutte le segnalazioni:

c'è ancora un click da abilitare, Show in draw order

Metti l'istruzione Stop in coda alla Sub ApriSito, subito prima di End Sub; quando la finestra IE si apre allora clicca a mano il link, poi vai sul vba e premi F5.
In questo modo puoi scegliere il Draw order o Ordine crescente

ci sono ancora 2/3 problemini,
il primo è che non mi copia l'ultima estrazione

Quale e' l'ultima estrazione? Eseguendo la macro adesso (ore 2:00 di lun 25-9) io parto da 2017-09-24_Lunchtime / 2017-09-24_Teatime.
Comunque manipolare la riga dDate = dDate + dDay - 1 non cambia la sequenza di estrazione, che e' quella proposta dal sito.

secondo se imposto la data 15/09/2017 mi copia anche quella del 14/09/2017
(per la data ho messo delle variabili tipo A,M,G in modo che dal foglio modifico la data nella macro)

Non so che modifica hai fatto, quindi non so valutare; ripeto che l'ordine di estrazione e' quella proposta dal sito: dalla piu' recente all'indietro.
Se vuoi partire da una data, sfruttando lo Stop che abbiamo messo prima, scegli in IE la data preferita prima di premere F5.

e per finire, terzo le estrazioni
vengono copiate dall'ultima attuale a quelle passate,
in questo caso bisogna copiare prima la TeaTime e poi la LunchTime

Questo lo risolvi con una macro autoregistrata che faccia l'ordinamento sulla base della colonna B con valori Decrescenti

in più ci vorrebbe una macro finale che mi sistemi le date ,
2017-09-22_TeaTime
cioè mi separi la data in colonna B 22/09/2017 dal lunchtime o teatime (queste in colonna J)

Visto che sei pronto a registrare una macro allora tanto vale che anche questa la risolvi con una macro autoregistrata:
-aggiungi una colonna prima delle estrazioni (quindi avrai ora una col C vuota)
-fai Testo-in-Colonna del contenuto di col A usando come separatore il carattere "_"
-se proprio vuoi, contr-x sulla colonna C, selezioni K1, Enter; rimuovi colonna C

eccoci qua, la macro ricomincia di nuovo a fare scherzi,
quando lancio la macro
copia tutte le estrazioni,
riclicco di nuovo e mi copia tutte le estrazioni tranne l'ultima del 23/09/2017
riclicco di nuovo copia tutte le estrazioni ma con la data del 22/09/2017 mancante,
ricliccando ancora mi da sempre tutte le estrazioni senza errori
è un errore saltuario.

Ho eseguito or ora una decina di volte la Main ottenendo sempre i risultati dal 2017-09-24_Lunchtime in avanti. Se hai risultati randomici prova ad aggiunere questa istruzione in questa posizione:

Codice: Seleziona tutto

    For k = 1 To 100
    myWait (0.2)                '<<< Aggiungere

Ciao

[Statix]

Ciao Anthony47,
le 2 modifiche del temporizzatore e dello stop con la selezione manuale dell'ordine di uscita ci ero già arrivato,
per quando riguarda le tabelle che hai visto, non ho separate l'estrazioni,
ben sì la prima tabella è quella che raccoglie tutte le estrazioni, mentre nella seconda tabella
mi ordina la sequenza di uscita delle estrazioni,
la macro copia i dati dalla più recente alla meno recente
quando sorteggiano le estrazioni esce prima la LunchTime e dopo la TeaTime
la sequenza di copia
esempio
attualmente è così (sbagliata)

24/09/2017 Lunchtime
24/09/2017 TeaTime
23/09/2017 LunchTime
23/09/2017 TeaTime
22/09/2017 LunchTime
22/09/2017 TeaTime

mentre quella giusta (corretta)

24/09/2017 TeaTime
24/09/2017 LunchTime
23/09/2017 TeaTime
23/09/2017 LunchTime
22/09/2017 TeaTime
22/09/2017 LunchTime

se si potrebbe modificare la macro all'origine, risparmierei,
delle colonne appoggio(la seconda Tabella)
e migliaia di formule.
con una nuova macro mi è difficile invertire ogni coppia di estrazioni (sono più di 6000 coppie).
come detto prima sarebbe più facile modificare la macro in origine.

[Anthony47]

Allora seguendo i miei consigli ho registrato questa macro:

Codice: Seleziona tutto

Sub Finisci()
'
    Columns("B:I").Select
    ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Add Key:=Range("B2:B737" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Foglio1").Sort
        .SetRange Range("B2:I737")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="_", FieldInfo:=Array(Array(1, 5), Array(2, 1)), TrailingMinusNumbers:=True
    Columns("C:C").Select
    Selection.Cut
    Range("K1").Select
    ActiveSheet.Paste
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
End Sub


Adesso puoi richiamarla in uscita dall Sub Main, inserendo l'istruzione Call Finisci subito prima di End Sub.

A me pare che il risultato e' quello che chiedevi:
-in ordine di data e ora decrescente
-con Teatime /Lunchtime in colonna J
Non ci sono colonne di appoggio da usare ne' formule.

Ciao

[Statix]

Ciao Anthony47,

ho provato adesso la macro Finisci, funziona solo per le estrazioni di un mese,
chiedevo non si puo modificare la macro DataColl
facendo in modo che copia prima l'estrazione del TeaTime
e poi quella del Lunchtime, ti posto la tabella,
la macro datacoll copia i dati in tabella B:I
mentre dovrebbe copiarli come in tabella K:R,
attualmente li traspongo con le formule ,
sul sito le estrazioni sono disposte prima LuchTime e poi TeaTime,
bisogna copiare prima la TeaTime e poi la LunchTime

[Anthony47]

Ci sono giorni che hanno solo il LunchTime, altri che hanno due estrazioni LunchTime, alcune che ne hanno anche tre (e forse qualcuna con quattro). Insomma non mi candido per andare a selezionare campi che un po' ci sono e un po' non ci sono.
Anche perche' non mi torna che "funziona solo per le estrazioni di un mese"; provato fino a giugno e mi ha ordinato tutto correttamente.

Piuttosto (e non so se questo possa essere il motivo della tua osservazione), nella mia Finisci ci sono riferimenti che si fermano alla riga 737 (evidentemente le estrazioni che avevo quando registrai la macro): modifica manualmente portandoli (in due istruzioni) fino a 10mila.
Quanto alla posizione della tabella importata dalla mia macro: importa i dati in un foglio diverso da quello che usi per le tue operazioni. Quando sono pronti e ordinati copiali da dove sono e incollali dove ti servono. Anche questa fase la puoi automatizzare con una macro autoregistrata.

Insomma credo di aver fatto il lavoro difficile ( ) quello noioso me lo vorrei evitare...

Ciao

[Statix]

Ciao Anthony47,
avrei bisogno di una ultima piccola modifica alla macro Datacoll,
ho riscontrato cioè che hai scritto , riguarda le estrazioni di cui alcune sono mancanti,
dal 2007 ad oggi ne mancano 4 non uscite del TeaTime,
di queste 4 vorrei che la macro mi mettesse degli 0 e non saltare l'estrazione (cioè non viene memorizzata),
esempio l'estrazione mancante memorizzarla con gli 0

Codice: Seleziona tutto

 prima estrazione      03/05/2013  LunchTime   1 2 3 4 5 6 7
 seconda estrazione       0                    0 0 0 0 0 0 0


ho una macro che mi scambia i dati tra 2 righe e se manca qualche estrazione non va bene,
questa la uso al posto della tua macro Finisci,
naturalmente per farla funzionare alla perfezione ho dovuto mettere alcune celle filtro,
la macro va lanciata una sola volta dopo aver raccolto i dati,
la variabile X è = 3 se le 2 estrazioni di testa sono dello stesso giorno
altrimenti X = 2
la macro copiaestrazione serve ad accodare l'estrazione di testa solo se X= 2
per non rimanere la riga vuota.

Codice: Seleziona tutto

Sub ScambiaRiga()
Dim URiga As Long, x As Long
Dim y As Byte
Dim Riga(2, 9)

Application.ScreenUpdating = False
URiga = Range("C" & Rows.Count).End(xlUp).Row + 1
If Range("Z5") = 0 Then
Exit Sub
End If
For x = Range("Z6") To URiga Step 2
        For y = 2 To 9
            Riga(1, y) = Cells(x - 1, y)
            Riga(2, y) = Cells(x, y)
        Next y
        For y = 2 To 9
            Cells(x - 1, y) = Riga(2, y)
            Cells(x, y) = Riga(1, y)
        Next y
Next x
Call CopiaEstrazione

End Sub
 

Codice: Seleziona tutto

Sub CopiaEstrazione()
Application.ScreenUpdating = False

If Range("Z6") = 3 Then
Exit Sub
End If
    Range("B1:I1").Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
End Sub

[Anthony47]

Tu insisti a voler modificare la datacoll, ma io insisto a fare queste modifiche sui dati importati dalla datacoll.
In particolare, dpo aver eseguito la Sub Finisci esegui questa ulteriore macro:

Codice: Seleziona tutto

Sub Pareggia()
Dim totR As Long, tRan As Range, I As Long, mOff As Long
'
totR = Cells(Rows.Count, "B").End(xlUp).Row
Set tRan = Range("B1").Resize(totR, 1)
For I = totR To 2 Step -1
        If Application.WorksheetFunction.CountIf(tRan, Cells(I, "B")) < 2 Then
            If Cells(I, "J") = "Lunchtime" Then mOff = 0 Else mOff = 1
            Cells(I + mOff, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            If mOff = 0 Then
                Cells(I, "B") = Cells(I + 1, "B"): Cells(I, "J") = "Teatime"
                Cells(I, "C").Resize(1, 7) = 0
            Else
                Cells(I + 1, "B") = Cells(I, "B"): Cells(I + 1, "J") = "Lunchtime"
                Cells(I + 1, "C").Resize(1, 7).Value = 0
            End If
    End If
Next I
End Sub


Questa, laddove per una data esiste una unica estrazione inserisce quella mancante.

Sappi pero' che dal sito si estraggono 113 giornate che hanno 3 estrazioni, es 25/10/1998; e 29 con 4 estrazioni (es 10/03/2010). Queste situazioni la Sub Pareggia non le tocca.

Ciao

[Statix]

Ciao Anthony47,
ti volevo chiedere come mai, se apro il sito dalla macro non mi da le ultime 2 estrazioni,
mentre se lo apro dal browser mi da le ultime 2 estrazioni,sia che con latest che previous
ho provato a cambiare nella macro con latest-results mi da solo una estrazione (Lunchtime)
in poche parole non riesco ad aggiornare le ultime 2 estrazioni.
per le ultime macro che hai postato, ti spiego dopo come ho risolto diversamente.

[Statix]

ok , stamattina aggiornato regolarmente,
ieri notte ho aspettato fino all'una sperando che si trattasse di un fuso orario,
ma non andava, la cosa strana che se aprivo il sito da internet mi visualizzava entrambe le 2 estrazioni
sia in latest che previous,
mentre aprendo il sito da macro non me li visualizzava nessuna delle 2,
modificando la riga

Codice: Seleziona tutto

myurl = "http://49s.co.uk/49s/previous-results/"
con
myurl = "http://49s.co.uk/49s/latest-results/"
 

sono riuscito a copiarne una sola,
aspetto oggi dopo le 14.00 per vedere se aggiorna la nuova.

[Anthony47]

Io non vedo problemi... Lanciata stamattina, ripetuta stasera (oggi pom non ho avuto tempo), ed ecco i risultati:



Provero' ancora piu' tardi, se ce la faccio.

Ciao

[Statix]

Ciao Anthony47,
devi provare dopo le 2 di pomeriggio e poi la sera dopo le sette,
comunque è già tanto quello che hai fatto finora,e ti ringrazio tantissimo,
credo di aver terminato il programma, la modifica che ho apportato per lo scambio delle estrazione
va perfettamente,ho risolto semplicemente con una colonna appoggio AF in cui
la formula verificava se c'erano 2 estrazioni con ugual data,
dava 1 oppure 0 che poi con questa macro con un ciclo for next mi scambiava le estrazioni,
quindi le 2 macro finisci e pareggia non sono servite,
un paio di estrazioni le ho dovute correggere a mano in quanto c'erano dei duplicati,

Codice: Seleziona tutto

Sub ScambiaEstrazioni()
Dim I As Integer
Dim Uriga As Long
Dim y As Byte
Dim riga(2, 9)
Uriga = Range("AF" & Rows.Count).End(xlUp).Row

For I = Uriga To 2 Step -1

If Range("AF" & I) = 1 Then
x = I
For y = 2 To 9
         riga(1, y) = Cells(x - 1, y)
            riga(2, y) = Cells(x, y)
        Next y
        For y = 2 To 9
           Cells(x - 1, y) = riga(2, y)
            Cells(x, y) = riga(1, y)
        Next y
End If
Next I

End Sub