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 » 22/11/11 20:21

:roll: fatto ho seguito alla lettere ma resta lo stesso problema.
in macro AggUK49 ho messo le 3 righe.
ma: in fgl appoggio ho 2 date dello stesso giorno e quando vado a riportarle in archivio
se c'e gia l'estrazione lunchtime non mi scrive l'estrazione teatime.

ovvio che se cancello le 2 date dello stesso giorno in archivio, tutto funziona,

mi riporta le 2 estrazioni con la stessa data, ma io dovrei riuscire a risolvere
il caso in cui in fgl archivio ho l'estrazione lunctime e vorrei aggiungere l'estrazione teatime.
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 Anthony47 » 22/11/11 22:32

Anthony ha scritto:... "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?
Come te lo devo dire??! Se hai in foglio Archivio_UK49s come ultima estrazione quella del lunch time LA DEVI CANCELLARE; da quel momento la nuova macro fara' l' aggiornamento solo con le estrazioni a coppia, mantenendo l' allineamento futuro.

Ci conto...
Avatar utente
Anthony47
Moderatore
 
Post: 19183
Iscritto il: 21/03/06 16:03
Località: Ivrea

Lotto estero

Postdi raimea » 23/11/11 07:03

:) confermo che l'aggiornamento a coppia funziona
(cosi ha sempre funzionato).
se possibile, io sto tentando di fare l'aggiornamento in fgl archivio di una-ad una.
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 » 23/11/11 10:20

Hum... forse stai cercando di dirmi con circospezione che come te l' ho raccontata io a te non funziona; cioe' che anche eliminando sull' archivio (una tantum) l' ultima estrazione lunch time (se e' l' ultima riga) poi l' aggiornamento non funziona.
Se e' cosi' allora posta le due macro che stai usando che riverifico.

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

Re: Lotto estero

Postdi Anthony47 » 23/11/11 16:06

In attesa del tuo riscontro sul messaggio precedente ho riletto il tuoi messaggi; forse stai cercando di dire che si, come suggerito ti funzionerebbe regolarmente ma in ogni caso preferiresti importare anche la sola estrazione lunch time? Se SI allora sappi che si puo' fare, e' appena piu' complicato di quanto avevo suggerito.

Vedo anche che sull' altro forum hanno chiesto di sapere la soluzione; se (come immagino) vorrai rispondere ti prego di inserire il link a questa discussione.

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

Lotto estero

Postdi raimea » 23/11/11 17:55

forse stai cercando di dire che si, come suggerito ti funzionerebbe regolarmente ma in ogni caso preferiresti importare anche la sola estrazione lunch time?

:lol: :lol: :lol: si,si,si...
vorrei poter caricare in fgl Archivio_UK49s, anche la sola estrazione teatime, in archivio
nel caso in cui ho gia riportato l'estrazione lunctime. delle h 14.00
queste le 2 macro richieste:
quella che preleva:
Codice: Seleziona tutto
Sub AggUK49()

   Worksheets("Appoggio").Select
   
   userform1.Show vbModeless
    DoEvents
    Inizio = Timer
   
   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("K2").Select
    ActiveCell.FormulaR1C1 = "pranzo"
    Range("K3").Select
    ActiveCell.FormulaR1C1 = "cena"
    Range("K2:K3").Select
    Selection.AutoFill Destination:=Range("K2:K21"), Type:=xlFillDefault
    Range("K2:K21").Select
    Range("P1").Select ' titolo
    ActiveCell.FormulaR1C1 = "le Ultime 20 Estrazioni"
 
    Range("b3:j22").Interior.ColorIndex = 2         '<<< qui colora una riga
    For RR = 3 To 22 Step 2
        Range("b" & RR & ":j" & RR).Interior.ColorIndex = 36
    Next RR

     For RR = 2 To 22 Step 2
        Range("b" & RR & ":j" & RR).Interior.ColorIndex = 35
    Next RR
   
    Range("O2").Select
 
       
    Unload userform1
    Fine = Timer
    MsgBox ("Tempo impiegato " & Int((Fine - Inizio) / 60) & " min " & (Fine - Inizio) Mod 60 & " Sec")
   
End Sub


quella che riporta le estrazioni mancanti in fgl archivio:
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


ri-confermo che quest'ultima funziona solo nel caso devo importare le date a "coppia"
non riporta se ho gia scritto l'estrazione delle ore 14 la lunctime.

ho spiegato anche nell'altro forum.
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 » 23/11/11 23:58

:lol: :lol: :lol: si,si,si...
Sarebbe bastato che quando ti proposi "di escludere dall' aggiornamento la sola estrazione lunch time (se cioe' manca quella del tea time)" avessi risposto "Ho capito, e infatti cosi' ho provato e funzionerebbe; pero' (per motivi che non ti voglio raccontare) vorrei che si potesse fare l' aggiornamento anche a meta' giornata" (o altra formula altrettanto chiara).
Ti avrei suggerito l' altra opzione:
-lascia la macro AggUK49 con tutti i dati importati, cioe' ignora le tre istrruzioni che ti avevo chiesto di aggiungere per importare sempre a coppie (msg del 21-nov sera)
-modifica la Aggiornaestrazionifglarchivio come segue (vedi istruzioni marcate **)
Codice: Seleziona tutto
'. . .
    UR2 = WS2.Range("B" & Rows.Count).End(xlUp).Row
    DataA = (WS2.Range("B" & UR2).Value + WS2.Range("B" & UR2 - 1).Value) / 2 '**
    DataApp = (WS1.Range("C" & UR1).Value + WS1.Range("C" & UR1 - 1).Value) / 2 '**
    If DataA >= DataApp Then   '**
    MsgBox "Non ci sono aggioramenti"
    GoTo SaltaAgg
    Else

    For RR1 = UR1 To 3 Step -1
    DataApp = (WS1.Range("C" & RR1).Value + WS1.Range("C" & RR1 - 1).Value) / 2 '** 
    If DataA = DataApp Then
'etc

NB: ho ignorato le nuove versioni di macro che hai pubblicato stasera; la macro di riferimento per me e' rimasta quella pubblicata da te il 22-11 pomeriggio. Tra l' altro nella macro di stasera continui a usare DateSeria e Mid per manipolare le date e non ne capisco il bisogno.

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

Lotto estero

Postdi raimea » 24/11/11 07:24

:D bingo.... :D
tutto ok, ora e' possibile riportare anche la sola estrazione serale teatime...

1.000 grazie
x voi il vba non ha limiti.... :)
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 » 27/11/11 07:39

V 3.05
ora i dati si scaricano da internet e viene aggiornato anche 'archivio in automatico.

vorrei aggiungere un altro piano alla "torre di babele.." :)

contare l'uscita di ogni colore nell'estrazione successiva in riferimento all' ultimo colore estratto.
nel fgl spia.jolly(fgl 10), c'e gia' una cosa fatta con i numeri.
basta scrivere in G4 che si compila subito la tabella in Col I5 per tutti i 49 numeri.
vorrei che scrivendo un colore in E4 mi compili la tabella sottostante
contando il colore uscito subito dopo andando a cercare nel fgl archivio Col K.

io ci ho provato "studiando" come si fa con i numeri, mi sono arenato
xche nel fgl 10 ci sono delle dichiarazioni che non riesco a gestire x fare la stesa cosa con le parole,
idem la macro--> spiajolly che e' nel modulo 9 ed e' quella che fa i conti ma si basa su dei numeri
mentre ora dovrei cercare contare 7 parole.
vi ringrazio
ciao
http://www.megaupload.com/?d=IFNFPJG6
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 » 27/11/11 09:15

Cosa intendi in questo passaggio?
raimea ha scritto:scrivendo un colore in E4 mi compili la tabella sottostante
contando il colore uscito subito dopo

Il primo colore uscito dopo il colore scelto?

Al posto di scrivere il colore, inserisci una convalida dati selezionando l'elenco dei colori in tabella
in maniera tale da evitare errori di digitazione del colore stesso. ;)

Penso tu possa risolvere da solo facendo assumento come stringa di ricerca il colore in E4
e poi calcolando le righe in archivio procedere a ritroso (dall'ultima riga archivio alla prima)
fino a trovare il colore in colonna K
una volta trovato inizi il tuo vero ciclo for next da quella riga+1 all'ultima riga dell'archivio.

Non so se è necessario perché puoi procedere in diverse maniere, ad esempio:
1) lavorando con le stringhe (nome colore trovato in archivio)
e ricercare per ognuno la corrispondenza in tabella foglio "Spia.jolly" una volta trovata la corrispondenza sommi il valore 1 al valore cella esistente (Col E)

2) con i numeri... Puoi far divenire una stringa come fosse un numero con un vettore dichiarato all'inizio della macro
Dim VStr(7) as string
E con un ciclo for next dalla riga 5 (-4) assegnare il colore al numero es.
Codice: Seleziona tutto
For RRC = 5 to 11
VStr(RRC-4) = Sheets(spia.jolly).Range("D" & RRC).value
Next RRC

Per ogni colore trovato lo riconverti in numero sempre con ciclo For next (questa volta da 1 a 7)
quando il colore corrisponde al vettore-stringa non fai altro che aggiungere 4 e avrai la riga corrispondente a quel colore e sommi in col E il valore 1 al valore della cella esistente (come per il punto 1).

Se riesci ok altrimenti, dopo che avrai chiarito la richiesta, ti darò qualche altro spunto.


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 » 27/11/11 09:33

si
Il primo colore uscito dopo il colore scelto?

come per il numero quando lo scritto in G5
vorrei contare i colori
Es se l'ultimo uscito e' il verde , il colore subito dopo
quante volte e' uscito il blu,giallo,verde,arancio ecc..
ok metto la convalida in E4
ciao,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 Flash30005 » 27/11/11 09:38

Rileggi il post precedente
credo di essere andato in modifica durante l'invio del tuo post
vedi se è chiaro quanto ho scritto su

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 » 27/11/11 10:04

azz la vedo dura... :-?
ho capito il ragionamento ma la realizz e' un altra cosa.
ho preso macro mod 9 che fa il lavoro con i numeri
e ho tentato di seguire i consigli, questo il risultato (che non va.. :oops: )
Codice: Seleziona tutto
Sub spiajcolorejolly()

userform1.Show vbModeless
DoEvents

Dim Vc(3) As String

Worksheets("spia.jolly").Unprotect   ' togli protez
Set WS1 = Worksheets("Archivio_UK49s")
Set WS2 = Worksheets("spia.jolly")
Estr = WS2.Range("E4").Value
WS2.Range("E5:E11").ClearContents
Application.ScreenUpdating = False
Application.Calculation = xlManual

Vc(1) = "Verde"
Vc(2) = "Rosso"
Vc(3) = "Arancio"
Vc(4) = "Giallo"
Vc(5) = "Marrone"
Vc(6) = "Viola"
Vc(7) = "Blu"


    UR1 = WS1.Range("A" & Rows.Count).End(xlUp).Row
        For RR1 = 3 To UR1
       
       
Continua:
            If WS1.Cells(RR1, 11).Value = Estr Then
               
                For RRC = 5 To 11
                 VStr(RRC - 4) = Sheets(spia.jolly).Range("D" & RRC).Value
              Next RRC
               
                    If WS1.Cells(RR1 + 1, 11).Value = NS Then
                        WS2.Range("k" & NS + 4).Value = WS2.Range("K" & NS + 4).Value + 1
                        RR1 = RR1 + 1
                        GoTo Continua
                    End If
                Next NS

            End If
        Next RR1
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'Call EvidenziaSpiajolly

Rows("5:54").Select
Selection.RowHeight = 18
Range("i1").Select

Unload userform1

End Sub

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 Flash30005 » 27/11/11 10:37

Infatti anche io ho preso quella macro "spiajolly" e ho notato che il calcolo righe lo fa sulla colonna A dove ci sono formule fino alla riga 9000 e più quindi in quella macro c'è da modificare il riferimento colonna con B e non A per accelerare i tempi e contare le righe effettive (4000 circa)
Codice: Seleziona tutto
UR1 = WS1.Range("B" & Rows.Count).End(xlUp).Row


Ora veniamo alla nuova macro
Codice: Seleziona tutto
Sub spiajollyCol()


userform1.Show vbModeless
DoEvents

Worksheets("spia.jolly").Unprotect   ' togli protez
Set WS1 = Worksheets("Archivio_UK49s")
Set WS2 = Worksheets("spia.jolly")
Estr = WS2.Range("E4").Value
Application.EnableEvents = False
WS2.Range("E5:E11").ClearContents
Application.ScreenUpdating = False
Application.Calculation = xlManual
    UR1 = WS1.Range("B" & Rows.Count).End(xlUp).Row
        For RR1 = UR1 To 3 Step -1
Continua:
            If WS1.Cells(RR1, 11).Value = Estr Then
            RigaI = RR1 + 1
            GoTo Trovato

            End If
        Next RR1
Trovato:
        For RR1 = RigaI To UR1
        CCS = WS1.Cells(RR1, 11).Value
            For RR2 = 5 To 11
            If CCS = WS2.Range("D" & RR2).Value Then
            WS2.Range("E" & RR2).Value = WS2.Range("E" & RR2).Value + 1
            GoTo SaltaRR2
            End If
SaltaRR2:
            Next RR2
        Next RR1
        Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


Unload userform1

End Sub


Avendo inserito la convalida in E4
ora bisogna far avviare al macro ad ogni variazione di valore in questa cella
implementando il codice Vba nel foglio con questo
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$G$4" Then GoTo SaltaR
Call spiajolly
SaltaR:
If Target.Address <> "$E$4" Then GoTo SaltaE
Call spiajollyCol
SaltaE:
If Target.Address <> "$A$1" Then Exit Sub
Call EvidenziaSpiajolly
   
End Sub


Fai sapere se ok

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-

Re: Lotto estero

Postdi raimea » 27/11/11 10:59

:undecided: le 2 macro sono ok,
solo che non mi fa il conteggio che intendevo, mi sa non mi sono spiegato bene... :eeh:
se scelgo in E4 verde:
io intendevo analizzare tutto l'archio, dopo il verde quante volte e'
uscito il viola,giallo,verde, arancio,blu,viola,rosso ?

nei conti che fa ora se scrivo E4 verde, mi dice che ad esempio il blu e' uscito solo 1 volta.
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 Flash30005 » 27/11/11 13:15

Avevo capito solo dall'ultima uscita del colore che ha un senso ben diverso, comunque...

Codice: Seleziona tutto
Sub spiajollyCol()


userform1.Show vbModeless
DoEvents

Worksheets("spia.jolly").Unprotect   ' togli protez
Set WS1 = Worksheets("Archivio_UK49s")
Set WS2 = Worksheets("spia.jolly")
Estr = WS2.Range("E4").Value
Application.EnableEvents = False
WS2.Range("E5:E11").ClearContents
Application.ScreenUpdating = False
Application.Calculation = xlManual
    UR1 = WS1.Range("B" & Rows.Count).End(xlUp).Row
    Trovato = 0
        For RR1 = 3 To UR1
            If WS1.Cells(RR1, 11).Value = Estr Then
                RigaI = RR1 + 1
                GoTo Trovato
            End If
        Next RR1
Trovato:
        For RR1 = RigaI To UR1
            CCS = WS1.Cells(RR1, 11).Value
            If CCS <> Estr Then
                For RR2 = 5 To 11
                    If CCS = WS2.Range("D" & RR2).Value Then
                        WS2.Range("E" & RR2).Value = WS2.Range("E" & RR2).Value + 1
                        GoTo SaltaRR2
                    End If
SaltaRR2:
                Next RR2
            End If
        Next RR1
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


Unload userform1

End Sub


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 » 27/11/11 14:04

:P tutto ok
grazie
sempre molto gentili.
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 » 27/11/11 22:30

:o mannaggia...
l'ultima macro di flash ha un "buco"... :)
non conta se-stesso,
cioe' : se in E4 scrivo "verde", mi fa correttamente il conteggio
su tutti i colori usciti subito dopo, ma non mi dice quanti
verdi , sono usciti subito dopo il --> verde.
si puo rimediare ?
ciao :neutral:
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 » 27/11/11 23:14

Non ha un buco ovvero quanto da te specificato sembrava appunto che non doveva considerare il colore scelta ma solo i colori seguenti a se stesso, o sbaglio?
Comunque con due modifiche ottieni anche il conteggio del colore scelto
Codice: Seleziona tutto
Sub spiajollyCol()


userform1.Show vbModeless
DoEvents

Worksheets("spia.jolly").Unprotect   ' togli protez
Set WS1 = Worksheets("Archivio_UK49s")
Set WS2 = Worksheets("spia.jolly")
Estr = WS2.Range("E4").Value
Application.EnableEvents = False
WS2.Range("E5:E11").ClearContents
Application.ScreenUpdating = False
Application.Calculation = xlManual
    UR1 = WS1.Range("B" & Rows.Count).End(xlUp).Row
    Trovato = 0
        For RR1 = 3 To UR1
            If WS1.Cells(RR1, 11).Value = Estr Then
                RigaI = RR1
                GoTo Trovato
            End If
        Next RR1
Trovato:
        For RR1 = RigaI To UR1
            CCS = WS1.Cells(RR1, 11).Value
            'If CCS <> Estr Then
                For RR2 = 5 To 11
                    If CCS = WS2.Range("D" & RR2).Value Then
                        WS2.Range("E" & RR2).Value = WS2.Range("E" & RR2).Value + 1
                        GoTo SaltaRR2
                    End If
SaltaRR2:
                Next RR2
            'End If
        Next RR1
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


Unload userform1

End Sub


Ma mi devi spiegare, a questo punto, perché iniziare quando si incontra il primo colore e non contare tutti i colori?
pensi che la differenza di 1 valore in più su 700 (circa) influisca qualcosa?
quindi ti invio anche la macro (molto semplificata) che conteggia tutti i colori puoi fare le dovute prove e ti renderai conto della ininfluenza dei risultati (avvii la prima macro, copi solo valori nel range F5:F11 e avvii quest'ultima macro...)
Codice: Seleziona tutto
Sub spiajollyColIntegrale()

userform1.Show vbModeless
DoEvents

Worksheets("spia.jolly").Unprotect   ' togli protez
Set WS1 = Worksheets("Archivio_UK49s")
Set WS2 = Worksheets("spia.jolly")
Estr = WS2.Range("E4").Value
Application.EnableEvents = False
WS2.Range("E5:E11").ClearContents
Application.ScreenUpdating = False
Application.Calculation = xlManual
    UR1 = WS1.Range("B" & Rows.Count).End(xlUp).Row
        For RR1 = 3 To UR1
            CCS = WS1.Cells(RR1, 11).Value
            For RR2 = 5 To 11
                If CCS = WS2.Range("D" & RR2).Value Then
                    WS2.Range("E" & RR2).Value = WS2.Range("E" & RR2).Value + 1
                    GoTo SaltaRR2
                End If
SaltaRR2:
            Next RR2
Next RR1
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Unload userform1
End Sub


A questo punto, penso sia più interessante, contare i colori successivi al colore scelto ma a partire dall'ultima estrazione come mia prima macro dove le differenze sono notevoli e il colore spia avrebbe un senso! 8)

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 » 28/11/11 06:57

:) ok ora conta anche se stesso.
Non ha un buco ovvero quanto da te specificato sembrava appunto che non doveva considerare il colore scelta ma solo i colori seguenti a se stesso, o sbaglio?

si', contare il colore uscito ma SOLO se nell' estrazione subito dopo,
qui mi e' pure venuto un dubbio xche' ho fatto la prova che mi hai consigliato,
facendo girare le 2 macro e i risultati sono identici.... :-?

la 1ma macro --> Sub spiajollyCol() mi dovrebbe conta solo i colori uscito SOLO nell'estrazione successiva vero ? :?:
mi sono accorto con
Codice: Seleziona tutto
conta.se(k3:k500;"rosso")
in fgl archivio , che la macro conta tutti i rossi, della colonna subito dopo il colore scritto in E4.
ma io intendo compilare la tabella sottostante ad E4 ,contanto i colori Solo nel caso di usciti l'estrazione successiva
non dopo 2,3,4, estrazioni. :-?

pensi che la differenza di 1 valore in più su 700 (circa) influisca qualcosa?

su questo non cambia nulla hai ragione, ma visto come siamo messi con il
rapporta S.ra "Fortuna", abbiamo deciso di non remare contro ma seguire.... ;)

A questo punto, penso sia più interessante, contare i colori successivi al colore scelto ma a partire dall'ultima estrazione come mia prima macro dove le differenze sono notevoli e il colore spia avrebbe un senso!

certo, la tua 1ma macro di ieri mica l'abbiamo "buttata" :D
e' nel file riporta i dati nello stesso foglio subito sotto.

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

PrecedenteProssimo

Torna a Applicazioni Office Windows


Topic correlati a "Lotto estero":


Chi c’è in linea

Visitano il forum: Nessuno e 36 ospiti