Script che in automatico rimuova da un gruppo numerico doc A un altro gruppo doc B

[lotto_tom75]

Fantasia o Realtà?

Sarebbe possibile creare uno script che tramite due tabelle "input" distinte consentisse di far questo?

>>> Rimuovere da un gruppo numerico doc A (immesso da tabella) un altro gruppo doc B (immesso in un'altra tabella)

E che magari riuscisse pure a calcolare per il gruppo "restante" C (= A-B) tutti gli RA x E in E su ruota voluta e l'RA medio di questi

Ciao a tutti/e a cominciare da Luigi, Legend, Mike, Joe ecc...

 

[LuigiB]

Ciao Tom ..della serie io ti do 1 2 3 4 e 1 2 3 4 5 6 lo script restituisce 5 6 ?

 

[lotto_tom75]

Ciao Tom ..della serie io ti do 1 2 3 4 e 1 2 3 4 5 6 lo script restituisce 5 6 ?

Esattamente e magari rilevasse per 5 e 6 i rispettivi RA x E sulla ruota voluta sommandoli e dividendo il risultato per 2 (secondo questo esempio) ottenendo così il loro RA medio del gruppo restante C (in questo caso 5 e 6 appunto) Ciao Big Lu

 

[LuigiB]

Bha lo script e decisamente banale come realizzazione...che vuol dire prendere i dati da tabella ?

 

[lotto_tom75]

Bha lo script e decisamente banale come realizzazione...che vuol dire prendere i dati da tabella ?

Due tabelle: una per immettere il gruppo A e l'altra per immettere il gruppo B. Intendevo banalmente questo

 

[LuigiB]

Eh ma non mi risulta ci siano tabelle per mettere numeri.. perciò non ho capito...li puoi mettere da inputbox o leggerli da file di testo..

 

[lotto_tom75]

Eh ma non mi risulta ci siano tabelle per mettere numeri.. perciò non ho capito...li puoi mettere da inputbox o leggerli da file di testo..

Io per tabella "input" intendo semplicemente questa

ReDim aNum(0)
QuantitaNumeriScelti = ScegliNumeri(aNum)

Che è presente in quasi ogni script.

Ce ne vorrebbe un'altra per il gruppo B da sottrarre... al primo A.

 

[LuigiB]

ah bhe .. ora ho capito .lo script è di una banalità e semplicita imbarazzanti . nel fine settimana te lo faccio se non ò'ha fatto prima qualcun altro

 

[lotto_tom75]

ah bhe .. ora ho capito .lo script è di una banalità e semplicita imbarazzanti . nel fine settimana te lo faccio se non ò'ha fatto prima qualcun altro

Non ho parole . GRAZIE magico!

 

[LuigiB]

ciao Tom , questo semplòice script ti propone due volte la scelta dei numeri in modo da ottenere 2 lunghette.
Successivamente individua tutti i numeri che sono presenti in una lunghetta ma non nell'altra ottenendo una terza lunghetta.
I numeri della terza lunghetta vengono analizzati per ritardo , i ritardi dei numeri trovati vengono sommati , al termine il valore della somma dei ritardi dei singoli numeri viene diviso per la quantita
dei numeri della terza lunghetta.
Non so se tu volevi solo sottrarre solo la seconda ala prima , lo script fa sia la seconda dalla prima che viceversa , nel caso cambia la riga dove fa il confronto

Option Explicit
Sub Main
    Dim aN1,aN2,ab1,ab2,aN
    Dim qt1,qt2
    Dim qt,k
    Dim nRuota
    Dim nRit,nRitTmp
    nRuota = BA_ ' ScegliRuota
    qt1 = ScegliNumeri(aN1)
    qt2 = ScegliNumeri(aN2)
    ab1 = ArrayNumeriToBool(aN1)
    ab2 = ArrayNumeriToBool(aN2)
    If qt1 > 0 And qt2 > 0 Then
        ReDim aN(90)
        qt = 0
        For k = 1 To 90
            If(ab1(k) And Not ab2(k)) Or(ab2(k) And Not ab1(k)) Then
                qt = qt + 1
                aN(qt) = k
            End If
        Next

        Call Scrivi ( )
        Call Scrivi ("Ruota     : "  & NomeRuota(nRuota))
        Call Scrivi ("Range     : "  & GetInfoEstrazione (EstrazioneIni) & " - " & GetInfoEstrazione (EstrazioneFin))
        Call Scrivi ("Esaminate : "  & EstrazioneFin - (EstrazioneIni -1) )
        Call Scrivi ("L1        : "  & StringaNumeri( aN1) )
        Call Scrivi ("L2        : "  & StringaNumeri( aN2) )


        If qt > 0 Then
            Call Scrivi ("LDiff     : "  & StringaNumeri( aN) )
            Call Scrivi ("QDiff     : "  & qt )

            Call Scrivi ( )


            ReDim Preserve aN(qt)
            Dim aV(2)
            aV(1) = "Numero"
            aV(2) = "Ritardo"
            Call InitTabella(aV)
            nRitTmp = 0
            For k = 1 To qt
                nRit = EstrattoRitardoTurbo(nRuota,aN(k),EstrazioneIni,EstrazioneFin)
                nRitTmp = nRitTmp + nRit
                aV(1) = aN(k)
                aV(2) = nRit
                Call AddRigaTabella(aV)
            Next
            Call CreaTabella(2)
            Call Scrivi("Ritardo medio : " & Dividi(nRitTmp,qt))
        Else
            Scrivi ("Nessuna differenza tra le due lunghette")
        End If
    Else
        MsgBox "Si devono selezionare due lunghette" , vbExclamation
    End If
End Sub

 

[lotto_tom75]

Luigi RIESCI SEMPRE A LASCIARMI AMMUTOLITO

Sono sempre in attesa della tua maglia "LUIGI FOR PRESIDENT" o similare

Se mai fonderai un PARTITO sarò uno dei tuoi primi ADERENTI!

M i t i c o !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6 indubbiamente il DYNAMO DEL CODICE
E ovviamente GRAZIEEEEEEEEEEEEEEEEEE di tutto!

 

[LuigiB]

mi sembra di capire che lo script andava bene ... Ciao

 

[fillotto]

Susate ancora l'ntiomissione, approfitto perchè vorrei una semplice delucidazione da luigi o anche da chi ne sfosse in grado per sapere se è possibile fare quanto andrò a dire:
Al n° 10 di questo post c'è uno script di Luigi x lottotom , come al solito a me piace adattare i file che trovo con lotterie estere perciò in questo caso lo script viene cos:

Sub Main
Dim aN1,aN2,ab1,ab2,aN
Dim qt1,qt2
Dim qt,k
Dim nRuota
Dim nRit,nRitTmp
'nRuota = BA_ ' ScegliRuota
Dim sez
Dim sfilearchivio
Dim ult
Dim clp
sez = InputBox("Quale Arc Virtuale vuoi prendere in considerazione? "," 1 - 6 ",1)
sfilearchivio = GetDirectoryAppData & "Svizzera\svizz" & sez & ".txt"
Call ApriBaseDatiFT(sfilearchivio,06,",",42)
'partenza = EstrazioniArchivioFT - 100
'fine = EstrazioniArchivioFT

qt1 = ScegliNumeri(aN1)
qt2 = ScegliNumeri(aN2)
ab1 = ArrayNumeriToBool(aN1)
ab2 = ArrayNumeriToBool(aN2)
If qt1 > 0 And qt2 > 0 Then
ReDim aN(42)
qt = 0
For k = 1 To 42
If(ab1(k) And Not ab2(k)) Or(ab2(k) And Not ab1(k)) Then
qt = qt + 1
aN(qt) = k
End If
Next

Call Scrivi()
Call Scrivi("Ruota     : " & "SWTZ") '   NomeRuota(nRuota))
Call Scrivi("Range     : " & GetInfoEstrazioneFT(EstrazioniArchivioFT - 420) & " - " & GetInfoEstrazioneFT(EstrazioniArchivioFT))
Call Scrivi("Esaminate : " & EstrazioniArchivioFT -(EstrazioniArchivioFT - 1))
Call Scrivi("L1        : " & StringaNumeri(aN1))
Call Scrivi("L2        : " & StringaNumeri(aN2))


If qt > 0 Then
Call Scrivi("LDiff     : " & StringaNumeri(aN))
Call Scrivi("QDiff     : " & qt)

Call Scrivi()


ReDim Preserve aN(qt)
Dim aV(2)
aV(1) = "Numero"
aV(2) = "Ritardo"
Call InitTabella(aV)
nRitTmp = 0
For k = 1 To qt
nRit = EstrattoRitardoFT(aN(k),EstrazioniArchivioFT - 420,EstrazioniArchivioFT)
nRitTmp = nRitTmp + nRit
aV(1) = aN(k)
aV(2) = nRit
Call AddRigaTabella(aV)
Next
Call CreaTabella(2)
Call Scrivi("Ritardo medio : " & Dividi(nRitTmp,qt))
Else
Scrivi("Nessuna differenza tra le due lunghette")
End If
Else
MsgBox "Si devono selezionare due lunghette",vbExclamation
End If
End Sub

funziona perfettamente anche in questo caso ,però devo affrontare lo cript sempre a una ruota ( a me si chiamano sezioni=Sez alla volta, per intenderci non posso addizionare un numero di una sez ad un numero di altra sez .
Insomma vorrei fare degli script per ricavare ad esempio analogamente a quanto si fa per trovare un ambo che manca per tutte le ruote ,trovare un ambo per tutte le sez.=szioni alias Ruote.
Luigi ptresti fare astrattamente ciò? trovare unambo che risuta il piu ritardato per tuttele ruote(sezioni)? Come spiegasti tempo fa le 11 ruote sono, un oggetto, , oggetto che a sua volta contiene altri oggetti che si chiamano ruote ecccc .
fare un script che ha per scopo

 

[joe]

Ciao Luigi.

Buona Giornata a tutte/i.

Voelvo chiederti una cosa.

Tom ha scritto: C = A - B ...

Ed è contento del tuo script.

Io avevo inteso come A not B.

La tua soluzione mi sembra essere A EXOR B.

Sottointendendo che, con i booleani,

trovo, per me, un pò più ostica o difficile la soluzione ...

Ho letto male la cosa?

 

[LuigiB]

ciao Joe , io per risolvere il problema come hai visto ho fatto un ulteriore intervista a lottotom
chiedendogli alcune confereme.

lui aveva scritto al primo post

>>> Rimuovere da un gruppo numerico doc A (immesso da tabella) un altro gruppo doc B (immesso in un'altra tabella)


io opo avergli proposto un esempio ho avuto conferma di cosa intendeva e lo script che gli ho fatto
fa sia quello che diceva lui che viceversa ..

ciao ...

 

[LuigiB]

ciao Filotto , ovviamente se lo scopo fosse trovare l'ambo piu ritardato per il lotto il seguente script si potrebe fare con molte meno righe di codice , ma dato che lo scopo era fare uno script che ti consentisse di modificarlo per cercare l'ambo piu ritardato su N file diversi l'ho fatto cosi ..

Option Explicit
Sub Main


    Dim aN
    ReDim aCol (2)
    Dim RitMax , Rit  
    Dim sAmbo
    Dim r
    Dim nFatte , nDaFare

    aN= GetNumPerSviluppo

    nDaFare = InitSviluppoIntegrale ( aN ,2)

    Do While GetCombSviluppo (aCol)
        For r = 1 To 10
            Rit = AmboRitardoTurbo(r ,aCol(1) ,aCol(2) , EstrazioneIni ,EstrazioneFin)
            If Rit > RitMax Then
                RitMax = Rit
                sAmbo = StringaNumeri(aCol)  & " " & NomeRuota(r)
            ElseIf Rit = RitMax Then
                sAmbo = sAmbo & vbCrLf & StringaNumeri(aCol)  & " " & NomeRuota(r)

            End If
        Next
        nFatte = nFatte +1
        Call AvanzamentoElab( 1 , nDaFare , nFatte)
    Loop

    Call Scrivi ("L'ambo col maggiore ritardo è : " & sAmbo & " al ritardo di " &  RitMax & " estrazioni")

End Sub

 

[fillotto]

Ciao Luigi grazie, però non funge.
All0ra io ho cambiato in questa maniera :
Tieni presente che ho in AppData la Cartella "Svizzera" all'interno della quale ho 7(o ruote, o come le chiamo io sezO, sez1,.....sez6) file
nello script che mihai fatto ho cambiato/aggiunto le righe remmate cosi' 'òòòòòòòòòòò però la prima cosa che ni dice è il file di testo non esiste dove sbaglio?

  Option Explicit
Sub Main

Dim sez
Dim sfilearchivio
Dim ult
Dim clp
'sez = InputBox("Quale Arc Virtuale vuoi prendere in considerazione? "," 1 - 6 ",1)
sfilearchivio = GetDirectoryAppData & "Svizzera\svizz" & sez & ".txt"                'òòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòò
Call ApriBaseDatiFT(sfilearchivio,06,",",42)                                         'òòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòò
'partenza = EstrazioniArchivioFT - 100
'fine = EstrazioniArchivioFT
    Dim aN
    ReDim aCol (2)
    Dim RitMax , Rit  
    Dim sAmbo
    Dim r
    Dim nFatte , nDaFare

    aN= GetNumPerSviluppo

    nDaFare = InitSviluppoIntegrale ( aN ,2)

    Do While GetCombSviluppo (aCol)
        For sez = 0 To 6                                                                            ''òòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòò              
  Rit = AmboRitardoFT (aCol(1) ,aCol(2) , EstrazioniArchivioFT-420 ,EstrazioniArchivioFT)           'òòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòòò
            If Rit > RitMax Then
                RitMax = Rit
                sAmbo = StringaNumeri(aCol)  & " " & "sez"(sez) 'òòòòòòòòòòòòòò
            ElseIf Rit = RitMax Then
                sAmbo = sAmbo & vbCrLf & StringaNumeri(aCol)  & " " & "sez"(sez) ''òòòòòòòòòòò

            End If
        Next
        nFatte = nFatte +1
        Call AvanzamentoElab( 1 , nDaFare , nFatte)
    Loop

    Call Scrivi ("L'ambo col maggiore ritardo è : " & sAmbo & " al ritardo di " &  RitMax & " estrazioni")

End Sub

 

[LuigiB]

se ti dice che il file non esiste è perche sbagli a costruire il percorso .. prova a mettere una msgbox per mostrare il percorso o fallo scrivere in output cosi ti rendi conto..
inoltre se hai 6 file diversi il file lo devi impostare ad ogni passaggio nel ciclo ..non solo all'inizio

 

[fillotto]

Non sono 6 file ma sette facilmente li potrei unire in un unico file tipo in un normale tabellonedi 42 colonne ma in questo caso dovrei mettere altre specifiche per fargli capire che ogni 6 colonne significa una ruota?

 

[Membro cancellato 16574]

Buongiorno,
Salutando tutti gli intervenuti , in primis LuigiB, con i grazie dovuti e Joe.
Postiamo la nostra visione del listato . con le dovute correzzioni e adeguamenti .
In attesa , che venga migliorata , perche' alquanto ferraginoso ed elementare .

Option Explicit
Sub Main
    Dim aN
    Dim Classe
    Classe = 02
    'aN = GetNumPerSviluppo
    'nDaFare = InitSviluppoIntegrale(aN,2)
    '--------------------------------------------------------------------------------------------------------------------------------
    Dim sez01
    sez01 = 01
    Dim sfilearchivio01
    sfilearchivio01 = GetDirectoryAppData & "Svizzera\svizz" & sez01 & ".txt"
    Call ApriBaseDatiFT(sfilearchivio01,06,",",42)
    ReDim aCol01(02)
    Dim nFatte01,nDaFare01
    Dim RitMax01,Rit01
    Dim sAmbo01
    nDaFare01 = InitSviluppaComb(aN,Classe)
    Do While GetCombSviluppo(aCol01)
        Rit01 = AmboRitardoFT(aCol01(01),aCol01(02),0001,EstrazioniArchivioFT)
        If Rit01 > RitMax01 Then
            RitMax01 = Rit01
            sAmbo01 = StringaNumeri(aCol01) & " " & "sez" &(sez01)
        ElseIf Rit01 = RitMax01 Then
            sAmbo01 = sAmbo01 & vbCrLf & StringaNumeri(aCol01) & " " & "sez" &(sez01)
        End If
        nFatte01 = nFatte01 + 01
        Call Messaggio(nFatte01 & " sezione " & sez01)
        Call AvanzamentoElab(01,nDaFare01,nFatte01)
    Loop
    Call Scrivi("L'ambo col maggiore ritardo è : " & sAmbo01 & " al ritardo di " & RitMax01 & " estrazioni" & " " & "sez" &(sez01))
    '--------------------------------------------------------------------------------------------------------------------------------
    Dim sez02
    sez02 = 02
    ReDim aCol02(02)
    Dim sfilearchivio02
    sfilearchivio02 = GetDirectoryAppData & "Svizzera\svizz" & sez02 & ".txt"
    Call ApriBaseDatiFT(sfilearchivio02,06,",",42)
    Dim nFatte02,nDaFare02
    Dim RitMax02,Rit02
    Dim sAmbo02
    nDaFare02 = InitSviluppaComb(aN,Classe)
    Do While GetCombSviluppo(aCol02)
        Rit02 = AmboRitardoFT(aCol02(01),aCol02(02),0001,EstrazioniArchivioFT)
        If Rit02 > RitMax02 Then
            RitMax02 = Rit02
            sAmbo02 = StringaNumeri(aCol02) & " " & "sez" &(sez02)
        ElseIf Rit02 = RitMax02 Then
            sAmbo02 = sAmbo02 & vbCrLf & StringaNumeri(aCol02) & " " & "sez" &(sez02)
        End If
        nFatte02 = nFatte02 + 01
        Call Messaggio(nFatte02 & " sezione " & sez02)
        Call AvanzamentoElab(01,nDaFare02,nFatte02)
    Loop
    Call Scrivi("L'ambo col maggiore ritardo è : " & sAmbo02 & " al ritardo di " & RitMax02 & " estrazioni" & " " & "sez" &(sez02))
    '--------------------------------------------------------------------------------------------------------------------------------
    Dim sfilearchivio03
    Dim sez03
    sez03 = 03
    sfilearchivio03 = GetDirectoryAppData & "Svizzera\svizz" & sez03 & ".txt"
    Call ApriBaseDatiFT(sfilearchivio03,06,",",42)
    ReDim aCol03(02)
    Dim nFatte03,nDaFare03
    Dim RitMax03,Rit03
    Dim sAmbo03
    nDaFare03 = InitSviluppaComb(aN,Classe)
    Do While GetCombSviluppo(aCol03)
        Rit03 = AmboRitardoFT(aCol03(01),aCol03(02),0001,EstrazioniArchivioFT)
        If Rit03 > RitMax03 Then
            RitMax03 = Rit03
            sAmbo03 = StringaNumeri(aCol03) & " " & "sez" &(sez03)
        ElseIf Rit03 = RitMax03 Then
            sAmbo03 = sAmbo03 & vbCrLf & StringaNumeri(aCol03) & " " & "sez" &(sez03)
        End If
        nFatte03 = nFatte03 + 01
        Call Messaggio(nFatte03 & " sezione " & sez03)
        Call AvanzamentoElab(01,nDaFare03,nFatte03)
    Loop
    Call Scrivi("L'ambo col maggiore ritardo è : " & sAmbo03 & " al ritardo di " & RitMax03 & " estrazioni" & " " & "sez" &(sez03))
    '--------------------------------------------------------------------------------------------------------------------------------
    Dim sez04
    sez04 = 04
    Dim sfilearchivio04
    sfilearchivio04 = GetDirectoryAppData & "Svizzera\svizz" & sez04 & ".txt"
    Call ApriBaseDatiFT(sfilearchivio04,06,",",42)
    ReDim aCol04(02)
    Dim nFatte04,nDaFare04
    Dim RitMax04,Rit04
    Dim sAmbo04
    nDaFare04 = InitSviluppaComb(aN,Classe)
    Do While GetCombSviluppo(aCol04)
        Rit04 = AmboRitardoFT(aCol04(01),aCol04(02),0001,EstrazioniArchivioFT)
        If Rit04 > RitMax04 Then
            RitMax04 = Rit04
            sAmbo04 = StringaNumeri(aCol04) & " " & "sez" &(sez04)
        ElseIf Rit04 = RitMax04 Then
            sAmbo04 = sAmbo04 & vbCrLf & StringaNumeri(aCol04) & " " & "sez" &(sez04)
        End If
        nFatte04 = nFatte04 + 01
        Call Messaggio(nFatte04 & " sezione " & sez04)
        Call AvanzamentoElab(01,nDaFare04,nFatte04)
    Loop
    Call Scrivi("L'ambo col maggiore ritardo è : " & sAmbo04 & " al ritardo di " & RitMax04 & " estrazioni" & " " & "sez" &(sez04))
    '--------------------------------------------------------------------------------------------------------------------------------
    Dim sez05
    sez05 = 05
    Dim sfilearchivio05
    sfilearchivio05 = GetDirectoryAppData & "Svizzera\svizz" & sez05 & ".txt"
    Call ApriBaseDatiFT(sfilearchivio05,06,",",42)
    ReDim aCol05(02)
    Dim nFatte05,nDaFare05
    Dim RitMax05,Rit05
    Dim sAmbo05
    nDaFare05 = InitSviluppaComb(aN,Classe)
    Do While GetCombSviluppo(aCol05)
        Rit05 = AmboRitardoFT(aCol05(01),aCol05(02),0001,EstrazioniArchivioFT)
        If Rit05 > RitMax05 Then
            RitMax05 = Rit05
            sAmbo05 = StringaNumeri(aCol05) & " " & "sez" &(sez05)
        ElseIf Rit05 = RitMax05 Then
            sAmbo05 = sAmbo05 & vbCrLf & StringaNumeri(aCol05) & " " & "sez" &(sez05)
        End If
        nFatte05 = nFatte05 + 01
        Call Messaggio(nFatte05 & " sezione " & sez05)
        Call AvanzamentoElab(01,nDaFare05,nFatte05)
    Loop
    Call Scrivi("L'ambo col maggiore ritardo è : " & sAmbo05 & " al ritardo di " & RitMax05 & " estrazioni" & " " & "sez" &(sez05))
    '--------------------------------------------------------------------------------------------------------------------------------
    Dim sez06
    sez06 = 06
    Dim sfilearchivio06
    sfilearchivio06 = GetDirectoryAppData & "Svizzera\svizz" & sez06 & ".txt"
    Call ApriBaseDatiFT(sfilearchivio06,06,",",42)
    ReDim aCol06(02)
    Dim nFatte06,nDaFare06
    Dim RitMax06,Rit06
    Dim sAmbo06
    nDaFare06 = InitSviluppaComb(aN,Classe)
    Do While GetCombSviluppo(aCol06)
        Rit06 = AmboRitardoFT(aCol06(01),aCol06(02),0001,EstrazioniArchivioFT)
        If Rit06 > RitMax06 Then
            RitMax06 = Rit06
            sAmbo06 = StringaNumeri(aCol06) & " " & "sez" &(sez06)
        ElseIf Rit06 = RitMax06 Then
            sAmbo06 = sAmbo06 & vbCrLf & StringaNumeri(aCol06) & " " & "sez" &(sez06)
        End If
        nFatte06 = nFatte06 + 01
        Call Messaggio(nFatte06 & " sezione " & sez06)
        Call AvanzamentoElab(01,nDaFare06,nFatte06)
    Loop
    Call Scrivi("L'ambo col maggiore ritardo è : " & sAmbo06 & " al ritardo di " & RitMax06 & " estrazioni" & " " & "sez" &(sez06))
    '--------------------------------------------------------------------------------------------------------------------------------
End Sub
Function InitSviluppaComb(anum,Classe)
    Dim k
    ReDim anum(42)
    For k = 01 To 42
        anum(k) = k
    Next
    InitSviluppaComb = InitSviluppoIntegrale(anum,Classe)
End Function

Controllare Sempre .
Salvo Errori ed Omissis .