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

Re: Lotto estero

Postdi raimea » 25/11/13 20:55

ciao

aiutino... :-?
serve un medico.... :eeh:

la macro -.-> compilambiprimo nel mod 1 fa i capricci.
l'ho usato ok fino al 17.11.13 ora mi si blocca in :
Immagine

Immagine

non ho modif. nulla nella macro di proposito.

la stessa cosa succede nella macro --> CompilaAmbijolly
identica macro ma riferita al num jolly.

allego il file....

https://db.tt/HNmFwRkH

grazie
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 raimea » 25/11/13 21:18

ciao
scusate il disturbo.. :-?
ho risolto.
erano 2 gg che provavo e riprovavo e solo dopo 20 min che avevo chiesto
il vostro aiuto ho risolto,
il forum porta bene...... :)

il problema era nella girnata del 21-11 avevo messo 2 volte stesso numero 33

Immagine

scusate
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 raimea » 24/11/16 19:09

ciao
tramite macro vorrei prelevare le ultime 20 estrazioni
riportate in fgl archivio e incollarle nel fgl appoggio.

dal foglio archivio copio :
le ultime 20 estrazioni da colonna B la data
fino a colo I

poi le incollo in fgl appoggio da cella C2
utilizzando il - INCOLLA SPECIALE=solo Valori


vi allego il file

grazie
ciao

https://dl.dropboxusercontent.com/u/96374724/preleva.rar
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 » 27/11/16 03:09

Devo aver capito male la richiesta, perche' mi pare che sei abituato a fare da solo cose piu' complesse.
Vediamo...
Si individua l'ultima istruzione dalla colonna Data, si copiano le ultime 20 righe di tabella (non capisco perche' da col B ignorando la colonna A, ma mi adeguo), si Incolla-Valori in Appoggio!C2
In codice, su un Modulo vba standard:
Codice: Seleziona tutto
Sub Muovi20()
Dim StartFrom As Long
'
StartFrom = Sheets("Archivio_UK49s").Cells(Rows.Count, 2).End(xlUp).Row - 19
If StartFrom < 3 Then StartFrom = 3
Sheets("Archivio_UK49s").Cells(StartFrom, "B").Resize(20, 8).Copy
Sheets("appoggio").Range("C2").PasteSpecial xlValues
Application.CutCopyMode = False
End Sub


Eventualmente richiamala tramite la macro di Worksheet_Activate di foglio "Appoggio":
Codice: Seleziona tutto
Private Sub Worksheet_Activate()
Call Muovi20
End Sub

Ricardati di metterla (questa seconda) sul "modulo di codice" del foglio Appoggio.

In questo modo il contenuto di Appoggio viene aggiornato all'attivazione del foglio.

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

Re: Lotto estero

Postdi raimea » 27/11/16 07:19

ciao
tutto ok

(non capisco perche' da col B ignorando la colonna A,

un mio errore , ho sistemato io in modo che prelevi anche dati da colA

sei abituato a fare da solo cose piu' complesse

non sono poi cosi bravo , si', ho realizzato file complessi ma sono sempre stato molto aiutato
in particolare da questo forum.

ancora grazie

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 raimea » 30/11/16 07:57

ciao
ho una macro vecchia di 3/4 anni che mi sono accorto mi fa dei conti errati
non l ho fatta io , ero stato aiutato ma non ricordo "dove".

vorrei riuscire a correggere l errore se possibile.
passo a descrivere cosa fa.

si chiama Sub tabelpardisp ed e' nel modulo3
questa si trova nel fgl ambata1mo
ed analizza SOLO il 1mo estratto (col C) del fgl archivio

-conto i numeri pari e dispari e li scrive nelle celle BT21 e BU21
-cerca la sequenza massima realizzata indicando di quante estrazioni e' composta
riportando il risultato in BT23 e BU23
-mette la data inizio e fine di tale sequenza massima scrivendolo in BT24/25 e BU24/25
-conta quante volta si e' ripetuta questa sequenza massima, e lo scrive in BT27 BU27
Codice: Seleziona tutto
Sub tabelpardisp()
 
 'DISATTIVO LE VARIE APPLICATION
 'IN MODO DA VELOCIZZARE L'ESECUZIONE DELLA MACRO

 Dim xlCal As XlCalculation
 With Application
     .ScreenUpdating = False
     .EnableEvents = False
     xlCal = .Calculation
     .Calculation = xlCalculationManual
 End With
'-----------------------------------------------------------
 Dim ws1 As Worksheet
 Dim ws2 As Worksheet
 Dim Area As Range
 Dim Cl As Range
 Dim Cl2 As Range
 Dim UltC As Long
 Dim Pari As Long
 Dim Dispari As Long
 Dim MaxSeq As Long
 Dim Maxx As Long
 Dim D_Inizio As Date
 Dim D_Fine As Date
 Dim DataI As Date
 Dim DataF As Date
 Dim Area2 As Range
 Dim Nriga As Long
 Dim Rip As Integer
 Dim Resto As Integer
 Dim t As Date

Worksheets("Ambata1mo").Unprotect   ' togli protez

 'VALORIZZO OGGETTI E VARIABILI
 Set ws1 = ThisWorkbook.Sheets("Archivio_UK49s")
 Set ws2 = ThisWorkbook.Sheets("Ambata1mo")
 
 UltC = ws1.Range("C" & Rows.Count).End(xlUp).Row
 Set Area = ws1.Range("C3:C" & UltC)
 Rip = 1
 t = Now

 'CANCELLO I VALORI NELLE CELLE DI DESTINAZIONE
 ws2.Range("BT21:BU21,BT23:BU25,BT27,BU27").ClearContents

 'CICLO PER TROVARE PARI E DISPARI
 For Each Cl In Area
     If Cl Mod 2 = 0 Then
         Pari = Pari + 1
     Else
         Dispari = Dispari + 1
     End If
 Next Cl

 'INSERISCO I VALORI PARI E DISPARI IN "FOGLIO1"
 ws2.Range("BT21").Value = Pari
 ws2.Range("BU21").Value = Dispari


 'CICLO CON 2 ITERAZIONI (UNA PER I PARI E UNA PER I DISPARI)
 For Resto = 0 To 1

     'CICLO OGNI CELLA DELLA COLONNA "C" TRANNE L'ULTIMA,
     'VISTO CHE NON HO ALTRI VALORI DA VERIFICARE DOPO DI ESSA
     For Nriga = 3 To UltC - 1
         
         'LA VARIABILE RESTO NELLA PRIMA ITERAZIONE VERIFICA
         'I NUMERI PARI, AVENDO VALORE 0; NELLA SECONDA
         'VERIFICHERà I VALORI DISPARI, AVENDO VALORE 1
         If ws1.Cells(Nriga, 3) Mod 2 = Resto Then
             
             'AUMENTO LA SEQUENZA DI UNA UNITà
             MaxSeq = MaxSeq + 1
             
             'IMPOSTO LA DATA DI INIZIO SEQUENZA
             D_Inizio = CDate(ws1.Cells(Nriga, 3).Offset(0, -1))
             
             'IMPOSTO L'AREA DALLA CELLA SEGUENTE A QUELLA CICLATA,
             'IN MODO DA VERIFICARE SE IL VALORE (PARO O DISPARO)
             'è LO STESSO DELLA CELLA CICLATA
             Set Area2 = ws1.Range(ws1.Cells(Nriga + 1, 3), ws1.Cells(UltC, 3))
             
             'INIZIO A CICLARE L'AREA APPENA SETTATA
             For Each Cl2 In Area2
                 
                 'SE IL VALORE è LO STESSO
                 If Cl2 Mod 2 = Resto Then
                                                                             
                     'AUMENTO LA SEQUENZA DI UNA UNITà
                     MaxSeq = MaxSeq + 1
                                                                             
                     'IN OGNI CASO IMPOSTO LA DATA DI FINE SEQUENZA
                     D_Fine = CDate(Cl2.Offset(0, -1))
                                                                             
                 'ALTRIMENTI
                 Else
                     
                     'LA VARIABILE "Maxx" SARà QUELLA CHE CONTERRà
                     'IL VALORE MAGGIORE DELLA SEQUENZA, MAN MANO CHE CICLERò
                     'LE CELLE
                               
                     'SE IL VALORE DELLA MASSIMA SEQUENZA TROVATA AL MOMENTO,
                     'è MAGGIORE O UGUALE ALLA VALORE DELLA MASSIMA SEQUENZA
                     'MEMORIZZATA IN PRECEDENZA (NATURALMENTE ALLA PRIMA ITERAZIONE
                     '"Maxx" AVRà VALORE 0), ALLORA...
                     If MaxSeq >= Maxx Then
                                                                                             
                         'QUI VERIFICO LA RIPETITIVITà DEL VALORE MASSIMO
                         If MaxSeq = Maxx Then
                             'SE è UGUALE INCREMENTO DI UNA UNITà
                             Rip = Rip + 1
                         Else
                             'ALTRIMENTI LO RIPORTO AL VALORE INIZIALE
                             Rip = 1
                         End If
                         
                         'PASSO I VALORI MEMORIZZATI ALLE NUOVE VARIABILI
                         'CHE CONTERRANNO I VALORI FINALI...
                         DataI = D_Inizio
                         DataF = D_Fine
                         Maxx = MaxSeq
                         
                         '...AZZERO LE VECCHIE VARIABILI PER INIZIARE UNA NUOVA ITERAZIONE....
                         D_Inizio = 0
                         D_Fine = 0
                         MaxSeq = 0
                         
                         '...IMPOSTO LA RIGA DA DOVE RIPRENDERò L'ITERAZIONE...
                         Nriga = Cl2.Row
                         
                         '...ESCO DAL CICLO INTERNO PER UNA NUOVA ITERAZIONE DEL CICLO ESTERNO
                         Exit For
                     
                     
                     'ALTRIMENTI AZZERO LE VECCHIE VARIABILI...
                     Else
                         D_Inizio = 0
                         D_Fine = 0
                         MaxSeq = 0
                         
                         '....IMPOSTO LA RIGA DA DOVE RIPRENDERò L'ITERAZIONE....
                         Nriga = Cl2.Row
                         
                         '...ED ESCO DAL CICLO INTERNO PER UNA NUOVA ITERAZIONE DEL CICLO ESTERNO
                         Exit For
                     End If
                 End If
             Next Cl2
         End If
     Next Nriga
     
     'INSERISCO I VALORI IN "FOGLIO1"
     ws2.Cells(23, 72 + Resto).Value = Maxx
     ws2.Cells(24, 72 + Resto).Value = DataI
     ws2.Cells(25, 72 + Resto).Value = DataF
     ws2.Cells(27, 72 + Resto).Value = Rip

 Next Resto

 'DISTRUGGO GLI OGGETTI
 Set ws1 = Nothing
 Set ws2 = Nothing
 Set Area = Nothing
 Set Area2 = Nothing

 'RIATTIVO LE VARIE APPLICATION
 With Application
     .Calculation = xlCal
     .EnableEvents = True
     .ScreenUpdating = True
 End With

 'MESSAGGIO CHE RESTITUISCE IL TEMPO DI ESECUZIONE DELLA MACRO
 MsgBox Format(Now - t, "HH:MM:SS"), vbInformation, "CODICE ESEGUITO IN......"

 End Sub


Immagine

il tutto e' corretto x i numeri PARI
mentre e' sbagliato x i numeri Dispari

la macro e' commentata ma non riesco a trovare come sistemarla.

allego il file
https://dl.dropboxusercontent.com/u/96374724/sequenze%20massima.rar

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 » 30/11/16 20:57

Prova questa variante:
Codice: Seleziona tutto
Sub SmarPD()
Dim myArch As Worksheet, I As Long, cEv As Boolean, cOdd As Boolean, ECnt As Long, OCnt As Long
Dim cOSeq As Long, cESeq As Long, OMax As Long, EMax As Long, OMCnt As Long, EMCnt As Long
Dim cOSeqStart As Long, cESeqStart As Long, myMESeq As Long, myMOSeq As Long
'
Set myArch = Sheets("Archivio_UK49s")
Sheets("Ambata1mo").Select
myTim = Timer
For I = 3 To myArch.Cells(Rows.Count, "B").End(xlUp).Row
'DoEvents
    If myArch.Cells(I, 3) Mod 2 = 0 Then
        ECnt = ECnt + 1
        If cEv Then
            cESeq = cESeq + 1
            cEv = True: cOdd = False
        Else
            cESeqStart = I: cESeq = 1
            If cOSeq = OMax Then OMCnt = OMCnt + 1
            If cOSeq > OMax Then OMax = cOSeq: OMCnt = 1: myMOSeq = cOSeqStart
            cOSeq = 0
            cOdd = False: cEv = True
        End If
    Else        'Is Odd
        OCnt = OCnt + 1
        If cOdd Then
            cOSeq = cOSeq + 1
            cEv = False: cOdd = True
        Else
            cOSeqStart = I: cOSeq = 1
            If cESeq = EMax Then EMCnt = EMCnt + 1
            If cESeq > EMax Then EMax = cESeq: EMCnt = 1: myMESeq = cESeqStart
            cESeq = 0
            cOdd = True: cEv = False
        End If
     End If
Next I
'
[BT21] = ECnt
[BU21] = OCnt
[BT23] = EMax
[BU23] = OMax
[BT27] = EMCnt
[BU27] = OMCnt
[BT24] = myArch.Cells(myMESeq, 2)
[Bu24] = myArch.Cells(myMOSeq, 2)
[BT25] = myArch.Cells(myMESeq + EMax - 1, 2)
[Bu25] = myArch.Cells(myMOSeq + OMax - 1, 2)
MsgBox ("Completato in (sec): " & Format(Timer - myTim, "0.0"))
'
End Sub
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Lotto estero

Postdi raimea » 30/11/16 21:28

:eeh:
OTTIMA
tutto ok e super veloce
esegue il tutto in meno di 2 Sec.... !

GRAZIE

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 raimea » 28/01/17 20:19

ciao
ho reciclato una macro,
ma ho un problema ad adattarla , per il calcolo dei ritardi e delle date del massimo ritardo.

ho 2 estrazioni a settimana mercol e sabato
ogni mer/sab, estraggono 3 settine
e sono scritte nel fgl archivio.

nel fgl ritardi con il pulsante
avvio la macro MaxRit nel modulo 1

questa mi sbaglia il calcolo dei ritardi dei 47 numeri
e si blocca con il calcolo delle date del max ritardo dal/al

ES
il num 13 ha un ritardo =1
ultima estraz 21-1

il num 1 ha un ritardo=2
il num 2=0
il num3=2

ritardi da riportare in col I

poi vorrei calcolare x ogni numero il max ritardo
da riportare in col F
e le relative date Dal / al

vi allego il file
https://dl.dropboxusercontent.com/u/96374724/lotto_47_ritardi.rar

grazie

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 » 30/01/17 00:29

Questa macro esamina i dati in foglio Archivio_47Irl e popola le tabelle in foglio Ritardi, E6 ed L6
Codice: Seleziona tutto
Sub peppa()
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=88989&p=634164#p634164
Dim AaArr, Iniz As String, Largh As Long, Last As String, flExit As Boolean
Dim rArr(1 To 47, 1 To 4), NN As Long, pOcc As Long, cOcc As Long
Dim rArr2(1 To 47, 1 To 2)
Dim iMax As Long, cMax As Long
Dim wS1 As Worksheet, wS2 As Worksheet
'
Iniz = "C3"
Largh = 7
Worksheets("ritardi").Unprotect   ' togli protez
userform1.Show vbModeless
    DoEvents
    INIZIO = Timer
Set wS1 = Worksheets("Archivio_47Irl")
Set wS2 = Worksheets("ritardi")
Application.ScreenUpdating = False
'
Last = wS1.Range(Iniz).Offset(Rows.Count - 100, Largh - 1).End(xlUp).Address(0, 0)
For NN = 1 To 47
    AaArr = Evaluate("(if(" & wS1.Name & "!" & Iniz & ":" & Last & "=" & NN & ",row(" & Iniz & ":" & Last & "),0))")
    pOcc = Range(Last).Row + 1
    For I = 1 To UBound(AaArr, 1)
        cOcc = Application.WorksheetFunction.Large(AaArr, I + 0)
        If cOcc = 0 Then
            cOcc = Range(Iniz).Row - 1
            flExit = True
        End If
        cRit = pOcc - cOcc - 1
        If cRit > rArr(NN, 1) Then
            rArr(NN, 1) = cRit
            rArr(NN, 3) = wS1.Cells(pOcc, Range(Iniz).Column - 1)
            rArr(NN, 2) = wS1.Cells(cOcc, Range(Iniz).Column - 1)
        End If
        If I = 1 Then rArr(NN, 4) = cRit
        pOcc = cOcc
        If flExit Then
            flExit = False
            Exit For
        End If
    Next I
Next NN
wS2.Select
Range("F6").Resize(47, 4) = rArr
Application.ScreenUpdating = True
'COMPILATA TABELLA RITARDI IN WS2
For I = 1 To 47
iMax = 0: cMax = 0
    For NN = 1 To 47
        If rArr(NN, 4) > cMax Then
            cMax = rArr(NN, 4)
            iMax = NN
        End If
    Next NN
    rArr2(I, 1) = iMax
    rArr2(I, 2) = cMax
    If iMax > 0 Then rArr(iMax, 4) = -1
Next I
'
Range("L6").Resize(47, 2) = rArr2
'
Unload userform1
   fine = Timer
   MsgBox ("Tempo impiegato " & Int((fine - INIZIO) / 60) & " min " & (fine - INIZIO) Mod 60 & " Sec")
End Sub

Sostituisce in toto la MaxRit attuale

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

Re: Lotto estero

Postdi raimea » 30/01/17 07:24

ciao
OTTIMO
me la studio un po' ;)
il conteggio del ritardo attuale, e' corretto

un info:
nella colonna G del fgl ritardi
ad alcuni numeri mette la data inizio Max ritardo " DAL "maggiore a : "AL "
ma non riesco capire il perché

ES i numeri 1-4-5-7-9
Immagine
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 » 30/01/17 11:14

Non avevo considerato correttamente un caso; sostituisci la riga rArr(NN, 2) = wS1.Cells(cOcc, Range(Iniz).Column - 1) con
Codice: Seleziona tutto
            rArr(NN, 2) = wS1.Cells(cOcc - flExit, Range(Iniz).Column - 1)

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

Re: Lotto estero

Postdi raimea » 30/01/17 17:24

corretto.
tutto bene
ancora Grazie

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

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "Lotto estero":


Chi c’è in linea

Visitano il forum: Nessuno e 45 ospiti