Richiesta script

[ducadecor]

Gentilmente qualcuno potrebbe fare uno script che ricerca un ambo ripetuto su una ruota in estrazioni consecutive non ha importanza se sono isotopi o no esempio su PA 26-1-19 17 - 82

29-1-19 PA 82 - 17 la ricerca va effetuata su tutte le ruote.

grazie anticipatamente

 

[Mike58]

Ciao ducadecor, eccoti la ricerca.
Se ci fai sapere poi prosegue la ricerca e a che fine magari poi è utile per noi tutti.

Sub Main
   Dim Nu(2),aN(2),Ru(1)
   Ini = EstrazioneFin - 200
   fin = EstrazioneFin
   For es = Ini To fin
      For r = 1 To 12
         If r = 11 Then r = 12
         For p1 = 1 To 4
            For p2 = p1 + 1 To 5
               a = Estratto(es,r,p1)
               b = Estratto(es,r,p2)
               For p3 = 1 To 4
                  For p4 = p3 + 1 To 5
                     c = Estratto(es - 1,r,p3)
                     d = Estratto(es - 1,r,p4)
                     If a = c Or a = d Then
                        If b = c Or b = d Then
                           k = k + 1
                           Call Messaggio("Trovati.... " & k)
                           Call AvanzamentoElab(Ini,fin,es)
                           Nu(1) = a
                           Nu(2) = b
                           aN(1) = c
                           aN(2) = d
                           Ru(1) = r
                           Scrivi GetInfoEstrazione(es - 1) & vbTab & StringaRuote(Ru) & vbTab & StringaEstratti(es - 1,r) & vbTab & StringaNumeri(aN,,1) & vbTab & "Pos " & p3 & "-" & p4
                           Scrivi GetInfoEstrazione(es) & vbTab & StringaRuote(Ru) & vbTab & StringaEstratti(es,r) & vbTab & StringaNumeri(Nu,,1) & vbTab & "Pos " & p1 & "-" & p2
                           Scrivi String(85,"=") & " Caso N. " & k
                        End If
                     End If
                  Next
               Next
            Next
         Next
      Next
   Next
End Sub

 

[joe]

Ciao, questa soluzione richiede Spaziometria:

Option Explicit
Sub Main
Dim Ini,Fin,Es,Ex,R,P,aEs,aEx
Ini = EstrazioneFin - 15 : Fin = EstrazioneFin
For ES = Ini To Fin
Ex = ES - 1
For R = 1 To 12 :If R = 11 Then R = 12
Call GetArrayNumeriRuota(Ex,R,aEx)
Call GetArrayNumeriRuota(ES,R,aEs)
If PuntiSuArray(aEx,aEs) >= 2 Then
Scrivi DataEstrazione(Es) & " " & SiglaRuota(R) & " Ripetuti ",False,False
For P = 1 To 5
If Posizione(Ex,R,aEs(P)) > 0 Then Scrivi Format2(aEs(P)) & Space(1),False,False
Next
Scrivi
End If
Next
Next
End Sub

 

[ducadecor]

grazie a Mike e Joe

per Mike58 mi da errore 13 tipo non corrispondente getinfoestrazione (riga28)

per Joe è ok

volevo applicare metodo di alcuni lottologhi per vedere se funzionano solo su ruota
grazie ancora per il vostro tempo

 

[Mike58]

Ciao ducadecor, il mio script è funzionante (copiato dal forum) come quello di joe.
Forse hai attivo Option Explicit e se è così devi disabilitarlo perché nel mio script non sono dichiarate tutte le variabili in dim.

P.s. dicci il prosieguo cosi facciamo la verifica sugli esiti e sull'utile.

 

[ducadecor]

scusa Mike58 avevo provato sull'altro famoso programma il tuo script mi da tutto il 2018 ok
sto provando con metodo di manara modificato e per il momento sto controllando a ritroso
ci sentiamo stasera o domani

 

[Mike58]

Beato te per la serata libera (io stasera e tutto il weekend lavoro).
Fai le dovute prove, poi ti leggerò con piacere.

Ciao

 

[ducadecor]

Ciao Mike proviamo con questi 29-12-18 CA 74 + 21 = 5 - 25 = 86 bidiametrale

02-01.19 CA 74 - 21 = 53 + 25 = 78 bidiametrale

per 6 estrazioni giochiamo i bidiametrali 86 - 78 ambata e anche ambetto e su tutte

 

[ducadecor]

sbagliato l' 86 è 70 scusa

sempre che con lo script si riesca