Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

PROBLEMA DI CARATTERE .... LOTTISTICO

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

PROBLEMA DI CARATTERE .... LOTTISTICO

Postdi elgamblero » 22/10/15 16:36

Salve a tutti,
premetto che sono uno studioso del lotto e che sto tentando di realizzare un programma in excel per ricavare delle previsioni basato su criteri fondati e non su teorie assurde. Ma mi sono impantanato su un passaggio che, nelle mie limitate conoscenze, non riesco a risolvere. Cerco di spiegare il problema con quanta più chiarezza posso.
Siano dati i seguenti estratti:

BARI 43 61 18 30 84
CAGLIARI 51 50 65 41 09

Sommando ognuno dei cinque numeri con gli altri della stessa ruota ottengo le seguenti somme (ricordo che la somma di 2 numeri al lotto se superiore a 90 viene "normalizzata" sottraendo 90 alla somma stessa, ad esempio 43+61 = 104-90 = 14):

1/2 1/3 1/4 1/5 2/3 2/4 2/5 3/4 3/5 4 /5
BARI 14 61 73 37 79 1 55 48 12 24
CAGLIARI 11 26 2 60 25 1 59 16 74 50

Ora mi occorre una formula (o una serie) che confronti i valori somma degli estratti delle due ruote per ciascuna posizione estrazionale (1/2, 1/3, 1-4 e così via) e se ne trova due eguali mi restituisca in 4 celle i 4 numeri che hanno originato le somme eguali.
Per capirci meglio:
tra le due ruote vi è un solo valore eguale, tra il 2° ed il 4° estratto di Bari ed il 2° e 4° estratto di Cagliari, pari ad 1 ed i numeri che generano questa eguaglianza sono 61 e 30 di Bari (61+30 = 91-90 = 1) e 50 e 41 di Cagliari (50+41 = 91-90 = 1).
Le ho provate tutte, ripeto, con le mie limitate conoscenze ma non sono riuscito a cavare un ragno dal buco.
Qualcuno può aiutarmi?
Grazie
elgamblero
Newbie
 
Post: 2
Iscritto il: 22/10/15 16:07

Sponsor
 

Re: PROBLEMA DI CARATTERE .... LOTTISTICO

Postdi By Sal » 23/10/15 09:06

Ciao Elgambero, premesso che di lotto non ne capisco molto.

vuoi una macro che ti riporta i 4 numeri oppure vediamo con le formule, per me con la macro è meglio.

una curiosità ma poi se non trova corrispondenza, che risultato avremo?.
ed ancora se sono più occorrenze ad esempio 2 o più bisogna riportarle tutte, perche per ogni coppia uguale si devono riportare 4 numeri.

questa però e mia curiosità ma alla fine questi 4 numeri che si fà?, servono per altri controlli.

a breve la macro.

Ciao By Sal (8-D
A rileggerci By Sal
Avatar utente
By Sal
Utente Junior
 
Post: 79
Iscritto il: 27/08/06 14:40

Re: PROBLEMA DI CARATTERE .... LOTTISTICO

Postdi elgamblero » 23/10/15 12:20

Salve Sal,
allora, se ce la possiamo fare con le formule è meglio ... le mie conoscenze sono limitate.
Per le tue domande ecco le risposte:
1) se non c'è corrispondenza tra le 10 somme delle due ruote deve andare oltre, ovvero leggere nella tabella che ho già creato con le somme degli estratti di tutte e 11 le ruote le successive. Se tra Bari e Cagliari non c'è nessuna rispondenza deve passare ad esaminare le due righe che contengono le somme di Cagliari e Firenze. Se è negativa anche questa ricerca passare a Firenze e Genova e così via, fino alla ultima coppia di ruote Venezia-Ruota Nazionale. Se non riscontra la condizione in nessuna coppia di ruote darmi un avviso, che so .. NEGATIVO o CONDIZIONE NON VALIDA
2) Se fra le due ruote che esaminiamo vi sono più equivalenze di somme deve darmi 4 numeri per ognuna di esse in celle distinte
3) ovviamente i 4 numeri servono per ulteriori calcoli.
Spero di essere stato chiaro e resto in attesa di tue indicazioni.
Grazie
elgamblero
Newbie
 
Post: 2
Iscritto il: 22/10/15 16:07

Re: PROBLEMA DI CARATTERE .... LOTTISTICO

Postdi By Sal » 23/10/15 17:28

Ciao Elgambero, eccoti la Macro

Codice: Seleziona tutto
Sub estrai()
Dim r, c, d, x, y, n, k, risp, arr1, arr2, arrA

arr1 = Range("B1:F1")
arr2 = Range("B2:F2")

Range("B5:K20").ClearContents
r = 5: c = 2
For x = 1 To 5
    For y = x + 1 To 5
        d = arr1(1, x) + arr1(1, y)
        If d > 90 Then d = d - 90
        Cells(r, c) = d
        c = c + 1
    Next y
Next x
r = 6: c = 2
For x = 1 To 5
    For y = x + 1 To 5
        d = arr2(1, x) + arr2(1, y)
        If d > 90 Then d = d - 90
        Cells(r, c) = d
        c = c + 1
    Next y
Next x
r = 9: c = 2
For x = 2 To 11
    If Cells(5, x) = Cells(6, x) Then
        Select Case x
            Case 2
                Cells(r, c) = arr1(1, 1): Cells(r, c + 1) = arr1(1, 2): Cells(r, c + 2) = arr2(1, 1): Cells(r, c + 3) = arr2(1, 2)
            Case 3
                Cells(r, c) = arr1(1, 1): Cells(r, c + 1) = arr1(1, 3): Cells(r, c + 2) = arr2(1, 1): Cells(r, c + 3) = arr2(1, 3)
            Case 4
                Cells(r, c) = arr1(1, 1): Cells(r, c + 1) = arr1(1, 4): Cells(r, c + 2) = arr2(1, 1): Cells(r, c + 3) = arr2(1, 4)
            Case 5
                Cells(r, c) = arr1(1, 1): Cells(r, c + 1) = arr1(1, 5): Cells(r, c + 2) = arr2(1, 1): Cells(r, c + 3) = arr2(1, 5)
            Case 6
                Cells(r, c) = arr1(1, 2): Cells(r, c + 1) = arr1(1, 3): Cells(r, c + 2) = arr2(1, 2): Cells(r, c + 3) = arr2(1, 3)
            Case 7
                Cells(r, c) = arr1(1, 2): Cells(r, c + 1) = arr1(1, 4): Cells(r, c + 2) = arr2(1, 2): Cells(r, c + 3) = arr2(1, 4)
            Case 8
                Cells(r, c) = arr1(1, 2): Cells(r, c + 1) = arr1(1, 5): Cells(r, c + 2) = arr2(1, 2): Cells(r, c + 3) = arr2(1, 5)
            Case 9
                Cells(r, c) = arr1(1, 3): Cells(r, c + 1) = arr1(1, 4): Cells(r, c + 2) = arr2(1, 3): Cells(r, c + 3) = arr2(1, 4)
            Case 10
                Cells(r, c) = arr1(1, 3): Cells(r, c + 1) = arr1(1, 5): Cells(r, c + 2) = arr2(1, 3): Cells(r, c + 3) = arr2(1, 5)
            Case 11
                Cells(r, c) = arr1(1, 4): Cells(r, c + 1) = arr1(1, 5): Cells(r, c + 2) = arr2(1, 4): Cells(r, c + 3) = arr2(1, 5)
        End Select
        r = r + 1
    End If
Next x
If Range("B9") = "" Then
    risp = MsgBox("Controllo se ci sono corrispondenze tra le due serie?", vbInformation + vbYesNo, "Controllo corrispondenze")
    If risp = 7 Then Exit Sub
    k = 5
    r = 9
    Set arrA = Range("B6:K6")
    For x = 2 To 11
        d = Cells(k, x)
        n = WorksheetFunction.CountIf(arrA, d)
        If n > 0 Then
            Select Case x
                Case 2
                    Cells(r, c) = arr1(1, 1): Cells(r, c + 1) = arr1(1, 2)
                Case 3
                    Cells(r, c) = arr1(1, 1): Cells(r, c + 1) = arr1(1, 3)
                Case 4
                    Cells(r, c) = arr1(1, 1): Cells(r, c + 1) = arr1(1, 4)
                Case 5
                    Cells(r, c) = arr1(1, 1): Cells(r, c + 1) = arr1(1, 5)
                Case 6
                    Cells(r, c) = arr1(1, 2): Cells(r, c + 1) = arr1(1, 3)
                Case 7
                    Cells(r, c) = arr1(1, 2): Cells(r, c + 1) = arr1(1, 4)
                Case 8
                    Cells(r, c) = arr1(1, 2): Cells(r, c + 1) = arr1(1, 5)
                Case 9
                    Cells(r, c) = arr1(1, 3): Cells(r, c + 1) = arr1(1, 4)
                Case 10
                    Cells(r, c) = arr1(1, 3): Cells(r, c + 1) = arr1(1, 5)
                Case 11
                    Cells(r, c) = arr1(1, 4): Cells(r, c + 1) = arr1(1, 5)
            End Select
            For y = 2 To 11
                If d = Cells(k + 1, y) Then
                    Select Case y
                        Case 2
                            Cells(r, c + 2) = arr2(1, 1): Cells(r, c + 3) = arr2(1, 2)
                        Case 3
                            Cells(r, c + 2) = arr2(1, 1): Cells(r, c + 3) = arr2(1, 3)
                        Case 4
                            Cells(r, c + 2) = arr2(1, 1): Cells(r, c + 3) = arr2(1, 4)
                        Case 5
                            Cells(r, c + 2) = arr2(1, 1): Cells(r, c + 3) = arr2(1, 5)
                        Case 6
                            Cells(r, c + 2) = arr2(1, 2): Cells(r, c + 3) = arr2(1, 3)
                        Case 7
                            Cells(r, c + 2) = arr2(1, 2): Cells(r, c + 3) = arr2(1, 4)
                        Case 8
                            Cells(r, c + 2) = arr2(1, 2): Cells(r, c + 3) = arr2(1, 5)
                        Case 9
                            Cells(r, c + 2) = arr2(1, 3): Cells(r, c + 3) = arr2(1, 4)
                        Case 10
                            Cells(r, c + 2) = arr2(1, 3): Cells(r, c + 3) = arr2(1, 5)
                        Case 11
                            Cells(r, c + 2) = arr2(1, 4): Cells(r, c + 3) = arr2(1, 5)
                    End Select
                    If n > 1 Then
                        Cells(r + 1, c) = Cells(r, c): Cells(r + 1, c + 1) = Cells(r, c + 1)
                        r = r + 1
                    Else
                        Exit For
                    End If
                End If
            Next y
            r = r + 1
        End If
    Next x
End If
Set arrA = Nothing
End Sub


in effetti avevo previsto che ci potessero essere più combinazioni,

ma per le estrazioni successive, si dovrebbe usare un altro sistema, però adesso se le inserisci manualmente funziona lo stesso

ti allego anche il file, questo il link

https://www.dropbox.com/s/otjsrfhgitdaq ... .xlsm?dl=0

fai copia incolla della serie "AF1:AJ2" in B1

in quelle estrazioni ci sono 3 serie di numeri anche se non opponibili, cioè nelle stesse posizioni.

ti da un avviso se non trova numeri opponibili per continuare.

Ciao By Sal (8-D



per lanciare la macro fai click sul calamaio
A rileggerci By Sal
Avatar utente
By Sal
Utente Junior
 
Post: 79
Iscritto il: 27/08/06 14:40


Torna a Applicazioni Office Windows


Topic correlati a "PROBLEMA DI CARATTERE .... LOTTISTICO":

Problema Windows 10
Autore: asso1998
Forum: Software Windows
Risposte: 1

Chi c’è in linea

Visitano il forum: Nessuno e 29 ospiti