Condividi:        

Lotto estero

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Lotto estero

Postdi raimea » 16/11/11 18:29

:lol: ai ragione
ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1408
Iscritto il: 11/02/10 07:33
Località: lago

Sponsor
 

Re: Lotto estero

Postdi Flash30005 » 16/11/11 18:51

Vedi questo post appena risolto
http://www.pc-facile.com/forum/viewtopic.php?f=26&t=93545
Considera invece che data odierna la tua data (inserita su una cella)
dalla Riga trovata (che considererai come UR) imposterai unFor...next così:
Codice: Seleziona tutto
For RR = Riga to 1 step - 1
....
'fai quello che devi fare
...
Next RR


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Lotto estero

Postdi raimea » 16/11/11 20:12

:oops: :oops:
io il ragionamento l'ho capito, ho letto " l'altra " macro
ma non riesco ad integrare le 2....

questo e' l'ultimo risultato (che ovviamente non funziona..)
Codice: Seleziona tutto
Sub RitAttCol2()



Dim Vc(10) As String
Application.ScreenUpdating = False
Application.Calculation = xlManual

ur = Worksheets("statistiche").Range("f50")
Sheets("Archivio UK49s").Select
urk = Range("K" & Rows.Count).End(xlUp).Row
for ur = urk
For VV = 1 To 7
ContaR = 0
Vc(VV) = Sheets("Statistiche").Range("F" & 51 + VV).Text
For RR = urk To 3 Step -1
    ContaR = urk - RR
    If Range("K" & RR).Text = Vc(VV) Then
        Sheets("Statistiche").Range("G" & 51 + VV).Value = ContaR
        GoTo SaltaVV
    End If
Next RR
SaltaVV:
Next VV
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


mi rendo conto che il cod scritto, a qualcuno possa sembrare una -bestemia- :undecided:
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1408
Iscritto il: 11/02/10 07:33
Località: lago

Re: Lotto estero

Postdi Flash30005 » 17/11/11 08:14

Ho modificato la macro precedente avendo ora l'opportunità di selezionare la data di ricerca nella cella D13 del foglio Statistiche.

Avrei potuto inviare solo la macro ma considerando che avresti potuto inserire una data non in elenco non avresti ottenuto alcun risultato quindi ho creato un Elenco dinamico delle date in archivio con convalida appunto in D13 (statistiche) per essere sicuri di scegliere una data esistente.

Fai attenzione perché ho rinominato il foglio Archivio Uk49 in quanto (non si dovrebbe MAI fare) hai lasciato uno spazio nel nome che ho sostituito con Underscore, spazio che non mi permetteva di creare l'elenco dinamico, chiaramente ho aggiornato tutte le macro esistenti nel Vba correggendo il nome del foglio.

All'apertura del file la data D13 si aggiornerà all'ultima in elenco archivio al fine di evitare di processare i ritardi con date utilizzate nei test di giorni precedenti.

Download File v.3

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Lotto estero

Postdi raimea » 17/11/11 17:54

:eeh: ottimo... e' perfetto
hai fatto molto di piu' di quanto pensavo..
stai dimostrando una pazienza infinita..., ma confesso io non ci sarei riuscito
a trovare la soluzione.

un info
in fgl statistiche d13 dove si scegli la data con il convalida
ho visto che hai creato un elenco di nome dataA, questo raggruppa la
prima data 29.8.2011, come faccio a modif questo elenco in modo parta dalla prima
data di fgl archivio ?

comunque infiniti ringraziamenti..
ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1408
Iscritto il: 11/02/10 07:33
Località: lago

Re: Lotto estero

Postdi sysuop33 » 17/11/11 18:03

ciao, anche con downloader File V.3 non riesco a visualizzarlo/scaricare..........
sysuop33 usa SO Linux 4.4 - Ubuntu 16.04 - LibreOffice 5.4
sysuop33
Utente Junior
 
Post: 64
Iscritto il: 09/09/11 08:59

Re: Lotto estero

Postdi Flash30005 » 17/11/11 18:14

L'elenco dinamico si aggiorna automaticamente iniziando (prima data in elenco) dall'ultima estrazione alla 158ª indietro
(corrispondente a più di un anno di estrazioni lotto, ma non nel tuo caso dove hai più estrazioni in un giorno)
Per modificare questo 158 vai sul Menu Inserisci -> Nome -> definisci
selezioni DataA e in basso modifichi il valore 158 ad altro numero
tieni presente, però, che più date inserisci e più è difficoltoso sceglierle nell'elenco in cascata, ma vedi tu.

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Lotto estero

Postdi raimea » 17/11/11 19:30

ok,
ho capito e sistemato
ancora grazie
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1408
Iscritto il: 11/02/10 07:33
Località: lago

Re: Lotto estero

Postdi Anthony47 » 19/11/11 11:49

Per quanto riguarda il calcolo dei ritardi dei colori, dovrebbe andare bene anche questa macro:
Codice: Seleziona tutto
Sub raicols()
aaaaa = Timer
Dim Estraz, EData, ListaCol, I As Long, J As Long, DelAr(), TabCol As String
Dim cCol As String, bDateI As Long, eDateI As Long, cDel As Long, Del As Long
Dim bMax As Long, eMax As Long
TabCol = "AJ16:AJ22"       '<< Tabella colori su Statistiche
ListaCol = Foglio14.Range(TabCol)
Estraz = Foglio21.Range("K3:K" & Cells(Rows.Count, "K").End(xlUp).Row)
EData = Foglio21.Range("B3:B" & Cells(Rows.Count, "K").End(xlUp).Row)
For I = LBound(ListaCol, 1) To UBound(ListaCol, 1)
    Del = 0: ReDim DelAr(3, UBound(Estraz, 1))
    cCol = ListaCol(I, 1): bDateI = LBound(EData, 1): eDateI = 99999
    For J = LBound(Estraz, 1) To UBound(Estraz, 1)
        If Estraz(J, 1) = cCol Then
            cDel = J - bDateI - 1
            If cDel > Del Then
            Del = cDel: bMax = bDateI: eMax = J
            End If
            bDateI = J
        End If
    Next J
'Compila risultati
sdata = Split(EData(bMax, 1), "/"): Foglio14.Range(TabCol).Range("A1").Offset(Ciclo, -1).Value = DateSerial(sdata(2), sdata(1), sdata(0))
Foglio14.Range(TabCol).Range("A1").Offset(Ciclo, 1).Value = Del
sdata = Split(EData(eMax, 1), "/"): Foglio14.Range(TabCol).Range("A1").Offset(Ciclo, 2).Value = DateSerial(sdata(2), sdata(1), sdata(0))
Ciclo = Ciclo + 1
Next I
MsgBox (Timer - aaaaa)
End Sub

Non ho inserito il codice per proteggere /Sproteggere il Foglio14, Statistiche.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Lotto estero

Postdi raimea » 19/11/11 18:25

:P
grazie x l'interessamento , troppo gentile,
non osavo disturbare ancora.....
ho risolto con questa macro:
Codice: Seleziona tutto
Sub Ritardo()
Dim Area As Range
Dim UltK As Long
Dim Ritardo As Integer
Dim CL As Range
Dim X As Integer
Dim Cella As Range
Dim Colori As Range
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = ThisWorkbook.Sheets("Archivio_UK49s")
Set WS2 = ThisWorkbook.Sheets("Statistiche")

userform1.Show vbModeless  '1
DoEvents
Inizio = Timer

Worksheets("statistiche").Unprotect   ' togli protez
Worksheets("archivio_uk49s").Unprotect   ' togli protez

UltK = WS1.Range("K" & Rows.Count).End(xlUp).Row
Set Area = WS1.Range("K3:K" & UltK)
Application.ScreenUpdating = False

Set Colori = WS2.Range("AJ16:Aj22") ' qui fgl statistiche, ci deveno essere i 7 colori da cercare/confrontare
Colori.Offset(0, 1).Resize(, 2) = ClearContents
Colori.Offset(0, -1).Resize(, 1) = ClearContents
With WS1
   For Each Cella In Colori
      Ritardo = 0
      For Each CL In Area
         If CStr(CL) <> CStr(Cella) Then
            Ritardo = Ritardo + 1
            Else
               If Ritardo <> 0 And Ritardo > CInt(Cella.Offset(0, 1)) Then
                  Cella.Offset(0, -1) = CDate(CL.Offset(-Ritardo, -9))
                  Cella.Offset(0, 1) = Ritardo
                  Cella.Offset(0, 2) = CDate(CL.Offset(0, -9))
               End If
               Ritardo = 0
         End If
      Next CL
   Next Cella
End With
Application.ScreenUpdating = True
Set Cella = Nothing
Set Area = Nothing
Set WS1 = Nothing
Set WS2 = Nothing
Set Colori = Nothing

Range("AI15:AL22").Select 'metto in ordine decrescente
    Selection.Copy
    Range("AI24").Select
    ActiveSheet.Paste
    Range("AI25:AL31").Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("AK25"), Order1:=xlDescending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("AG24").Select

ActiveWindow.DisplayGridlines = False  'metti protez e nascondi griglia
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True
   
     Unload userform1    '2
     
     Fine = Timer
    MsgBox ("Tempo impiegato " & Int((Fine - Inizio) / 60) & " min " & (Fine - Inizio) Mod 60 & " Sec")
   
End Sub

Grazie.
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1408
Iscritto il: 11/02/10 07:33
Località: lago

Lotto estero

Postdi raimea » 21/11/11 17:14

V 3.03
buon giorno a tutti.
ho un problemino, con una macro che mi funziona prelevando i dati in un sito internet

http://www.mondobet.net/lotto/lotto-49s

solo che questa pagina ultimamente non viene piu' aggiornata.

vorrei cambiare sito/pagina da cui prelevare i dati esattamente da questo sito/pagina:
http://www.lottoanalyzer.it/analisi_estrazioni_uk_49s.asp

solo che non riesco ad adattare la mia macro per fare cio che mi serve.

a me servono solo la data e i 7 numeri alla sua Dx , se si prelevano anche gli altri numeri( che non mi servono), potranno essere cancellati una volta scritti nel foglio excell.
e' possibile fare questo ? :?:

nel mio file i dati prelevati vengono scritti nel fgl -appoggio -
questa la macro che uso ora:
Codice: Seleziona tutto
Sub AggUK49()

   Worksheets("Appoggio").Select
   
   userform1.Show vbModeless
    DoEvents

   
   Worksheets("appoggio").Unprotect   ' togli protez
   
 
   Range("A1:I65").Select  ' cancello il contenuto precedente
    Selection.ClearContents
       
    Range("A1").Select
   
   
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http:www.mondobet.net/lotto/lotto-49s", Destination:=Range( _
        "$A$1"))
        .Name = "?page_id=108"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
   
    Range("A2:H52").Select  ' ordino dal piu vecchio al piu recente
        Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
   
 
    Range("O2").Select
   
   
    Unload userform1
   
End Sub

provo ad allegare il file

vi ringrazio.

http://www.megaupload.com/?d=JESMUTS9
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1408
Iscritto il: 11/02/10 07:33
Località: lago

Re: Lotto estero

Postdi Anthony47 » 21/11/11 19:49

Lieto che hai risolto con altri sistemi; bene

Se invece vuoi ancora prelevare i dati dal sito che hai linkato, immagino che il problema sta' nel fatto che il nuovo sito non sembra disporre di una tabella relativa ai soli dati che ti interessano. "Sembra"...
Infatti se guardi il sorgente puoi rilevare invece che il tutto corrispnde alla tabella #4

Allora?
In generale, non perdersi d' animo:
-registra la query per importare quello che passa il convento, cioe' tutta la pagina
-visualizza poi il sorgente della pagina html e ricostruisci posizione e contenuti delle tabelle; per questo basta una conoscenza di base dell' html, e si procede ricercando i tag "<Table> </Table>" e i suoi componenti "<Tr> </Tr>" e "<Td> </Td>"
Identificata la tabella da importare se ne rileva l' indice (si conta se e' la prima, la seconda, la teza etc tabella) e si usa questo indice nel codice da modificare.
Nel tuo caso:
Codice: Seleziona tutto
'.WebSelectionType = xlEntirePage          'Trovi una riga cosi'; eliminala...
.WebSelectionType = xlSpecifiedTables  ' .. e sostituisci con questa
.WebTables = "4"                      '<< Subito dopo aggiungere l' indice di tabella
'Continuare con le istruzioni registrate

Cancella a questo punto il contenuto del foglio Appoggio ed esegui la macro.

Ti ho omesso particolari non secondari, come selezionare fogli, visualizzare la form portafortuna, proteggere /Sproteggere, e le altre elaborazioni che, non avendo seguito la discussione precedente, mi veniva difficile comprendere dal codice della macro.

Nell' ipotesi che la cosa sia di qualche interesse.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Lotto estero

Postdi raimea » 21/11/11 20:37

fotto.. :D
grazie
ho capito il procedimento , cio che non riuscivo a trovare
era il riferimento ---> .WebTables = "4"

ora funge, :) ecco la macro finale con tutti gli accessori.... :P
Codice: Seleziona tutto
Sub AggUK49()

   Worksheets("Appoggio").Select
   
   userform1.Show vbModeless
    DoEvents

   
   Worksheets("appoggio").Unprotect   ' togli protez
   
 
   Range("A1:w65").Select  ' cancello il contenuto precedente
    Selection.ClearContents
       
    Range("A1").Select
   
   
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.lottoanalyzer.it/analisi_estrazioni_uk_49s.asp", Destination:=Range( _
        "$A$1"))
        '.Name = "?page_id=108"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "4"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
   
    Range("K1:N23").Select ' tolgo dati importati che non mi servono
    Selection.ClearContents
    Range("R2").Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "1" 'numero col A
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    Range("A3").Select
    Selection.AutoFill Destination:=Range("A3:A22"), Type:=xlFillDefault
    Range("A3:A22").Select
    Range("A2:A22").Select
    Selection.Font.Bold = True
    Selection.Locked = True
    Selection.FormulaHidden = True
    Range("L2").Select
 
    Range("O2").Select
   
   
    Unload userform1
   
End Sub

ora preleva solo le ultime 20 estrazni ma almeno sono aggiornate
di nuovo 1000 grazie
ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1408
Iscritto il: 11/02/10 07:33
Località: lago

Lotto estero

Postdi raimea » 21/11/11 22:03

azz, :(
ora che ho i dati aggiornati in fgl appoggio con una macro li vado ad inserire nel
fgl archivio se mancanti, ma ho "2 imprevisiti"

Codice: Seleziona tutto
Sub Aggiornaestrazionifglarchivio()


Set WS1 = Worksheets("appoggio") 'dove preleva
Set WS2 = Worksheets("Archivio_UK49s") ' dove deve inserire se mancante
Worksheets("Archivio_UK49s").Unprotect
UR1 = WS1.Range("C" & Rows.Count).End(xlUp).Row
UR2 = WS2.Range("B" & Rows.Count).End(xlUp).Row
DataA = DateSerial(Mid(WS2.Range("B" & UR2).Value, 7, 4), Mid(WS2.Range("B" & UR2).Value, 4, 1), Mid(WS2.Range("B" & UR2).Value, 1, 2))
DataApp = DateSerial(Mid(WS1.Range("C" & UR1).Value, 7, 4), Mid(WS1.Range("C" & UR1).Value, 4, 1), Mid(WS1.Range("C" & UR1).Value, 1, 2))
If DataA = DataApp Then
MsgBox "Non ci sono aggioramenti"
GoTo SaltaAgg
Else

For RR1 = UR1 To 3 Step -1
DataApp = DateSerial(Mid(WS1.Range("C" & RR1).Value, 7, 4), Mid(WS1.Range("C" & RR1).Value, 4, 1), Mid(WS1.Range("C" & RR1).Value, 1, 2))
If DataA = DataApp Then
RigaA = RR1 + 1
GoTo Aggiorna
End If
Next RR1
End If
Aggiorna:
For RR1 = RigaA To UR1
UR2 = WS2.Range("B" & Rows.Count).End(xlUp).Row + 1
WS2.Range("B" & UR2).Value = WS1.Range("A" & RR1).Value
WS2.Range("C" & UR2 & ":I" & UR2).Value = WS1.Range("D" & RR1 & ":J" & RR1).Value
Next RR1
MsgBox "Archivio Aggiornato"
SaltaAgg:

End Sub

1°) non mi scrive la data nel formato corretto ho provato varie madifice ma in col B
di fgl archivio scrive una data senza senso.
2°) nello stesso gg ci sono 2 estrazioni e con la macro sopra se ho gia scritto l'estraz del -->LunchTime
mi dice che non ci sono dati da aggiungere ed e' tutto ok,
per ovviare a questo si potrebbe usare la col J di fgl archivio, che appunto specifica quale delle 2 estrazioni e' mancante, ma come modificare la macro ? :?:
ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1408
Iscritto il: 11/02/10 07:33
Località: lago

Re: Lotto estero

Postdi Anthony47 » 21/11/11 23:14

Ma se in col B sia di Archivio_UK49s che di Appoggio hai delle vere date, e le hai, perche' vai a inventarti nuove date tramite DateSerial e Mid? Bastera'
Codice: Seleziona tutto
    DataA = WS2.Range("B" & UR2).Value
    DataApp = WS1.Range("C" & UR1).Value
(una cosa analoga anche nella seconda macro)

Per l' altro discorso, immagino che ci sono sempre 2 estrazioni per la stessa data; se e' cosi' allora per me la cosa piu' semplice e' che eviti di importare l' estrazione lunch time; per questo dovrebbe bastare questa aggiunta in coda alla macro AggUK49:
Codice: Seleziona tutto
        Range("O2").Select   'esistente
'aggiungere le prossime 3
If Cells(Rows.Count, "C").End(xlUp).Value <> Cells(Rows.Count, "C").End(xlUp).Offset(-1, 0).Value Then
Cells(Rows.Count, "C").End(xlUp).Offset(0, -1).Resize(1, 10).ClearContents
End If
        Unload userform1   'esistente
Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Lotto estero

Postdi raimea » 22/11/11 06:54

azz, forse non mi sono spiegato bene. :cry:
nel fgl archivio le date sono in Col B
nel fogl appoggio sono in Col C.

e' corretto avere 2 estrazioni al gg in entrambi i fogli.

il problema si presenta quando nel fgl archivio ho gia scritto/riportato,
le estrazioni delle h 14, la macro -" aggiornaestrazioniarchivio" trova gia' una data odierna
e non riporta piu la 2da estrazione delle ore 18 che in realta' ho in fgl appoggio,
e dovrebbe essere riportata.
provo ad allegare il file.
grazie, ciao.

http://www.megaupload.com/?d=1YR0LXVA
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1408
Iscritto il: 11/02/10 07:33
Località: lago

Re: Lotto estero

Postdi raimea » 22/11/11 07:29

fuori una :lol:
ho risolto il problema formato date.... ora le riporta giuste.
avevo questa riga scritta sbagliata
Codice: Seleziona tutto
WS2.Range("B" & UR2).Value = WS1.Range("C" & RR1).Value


viene usato "mind" per fare il lavoro sulle solo date mancanti quindi dovrebbe essere piu veloce.

ora rimane come aggiornare fgl archivio con 2 estrazioni al giorno :roll:
ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1408
Iscritto il: 11/02/10 07:33
Località: lago

Re: Lotto estero

Postdi Anthony47 » 22/11/11 13:41

Evidentemente mi sono spiegato male anche io:
-volevo sottolineare che avevi gia' le date a posto, non avevi bisogno di ricalcolarle (male) con DateSerial e Mid
-volevo suggerire di escludere dall' aggiornamento la sola estrazione lunch time (se cioe' manca quella del tea time), cosa che si fa con le tre istruzioni che ho postato ieri sera.
Provale, prima cancella dall' archivio l' ultima estrazione presente, se riferita al lunch time.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Lotto estero

Postdi raimea » 22/11/11 18:15

:lol: quasi ci capiamo..
per questo dovrebbe bastare questa aggiunta in coda alla macro AggUK49:

Range("O2").Select 'esistente
'aggiungere le prossime 3
If Cells(Rows.Count, "C").End(xlUp).Value <> Cells(Rows.Count, "C").End(xlUp).Offset(-1, 0).Value Then
Cells(Rows.Count, "C").End(xlUp).Offset(0, -1).Resize(1, 10).ClearContents
End If
Unload userform1 'esistente

ma la macro che fa il passaggio dal fgl appoggio ad archivio non e' -->agguk49
ma questa:
Codice: Seleziona tutto
Sub Aggiornaestrazionifglarchivio()


Set WS1 = Worksheets("appoggio") 'dove preleva
Set WS2 = Worksheets("Archivio_UK49s") ' dove deve inserire se mancante
Worksheets("Archivio_UK49s").Unprotect
UR1 = WS1.Range("C" & Rows.Count).End(xlUp).Row
UR2 = WS2.Range("B" & Rows.Count).End(xlUp).Row


DataA = DateSerial(Mid(WS2.Range("B" & UR2).Value, 7, 4), Mid(WS2.Range("B" & UR2).Value, 4, 1), Mid(WS2.Range("B" & UR2).Value, 1, 2))
DataApp = DateSerial(Mid(WS1.Range("C" & UR1).Value, 7, 4), Mid(WS1.Range("C" & UR1).Value, 4, 1), Mid(WS1.Range("C" & UR1).Value, 1, 2))


If DataA = DataApp Then
MsgBox "Non ci sono aggioramenti"
GoTo SaltaAgg
Else

For RR1 = UR1 To 3 Step -1
DataApp = DateSerial(Mid(WS1.Range("C" & RR1).Value, 7, 4), Mid(WS1.Range("C" & RR1).Value, 4, 1), Mid(WS1.Range("C" & RR1).Value, 1, 2))
If DataA = DataApp Then
RigaA = RR1 + 1
GoTo Aggiorna
End If
Next RR1
End If
Aggiorna:
For RR1 = RigaA To UR1
UR2 = WS2.Range("B" & Rows.Count).End(xlUp).Row + 1
WS2.Range("B" & UR2).Value = WS1.Range("C" & RR1).Value
WS2.Range("C" & UR2 & ":I" & UR2).Value = WS1.Range("D" & RR1 & ":J" & RR1).Value
Next RR1
MsgBox "Archivio Aggiornato"
SaltaAgg:

End Sub

quindi non so' dove mettere le 3 righe che mi hai postato :-?

al momento se cancello in fgl archivio l'ultima estraz --> teatime
mi dice archivio gia aggiornato e in fgl archivio non mi riporta l'estrazione teatime
(la 2da della giornata con la stessa data).
ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1408
Iscritto il: 11/02/10 07:33
Località: lago

Re: Lotto estero

Postdi Anthony47 » 22/11/11 19:49

Quasi ci siamo, ma un po' piu' di fiducia no?
Mettila dove ti dissi (cioe' in AggUK49); poi "cancella dall' archivio l' ultima estrazione presente, se riferita al lunch time" (come dissi; cioe' non lasciare una situazione compilata a meta'); poi aggiorna dal sito (tramite macro) e aggiorna l' archivio (altra macro).
Noterai che se sul sito l' ultimo aggiornamento e' al lunch time questo non sara' riportato nel tuo Appoggio, e quindi nemmeno nell' Archivio; e' una semplificazione che mi sono fatta io, e' sbagliata?

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

PrecedenteProssimo

Torna a Applicazioni Office Windows


Topic correlati a "Lotto estero":


Chi c’è in linea

Visitano il forum: Nessuno e 34 ospiti

cron