Novità

un piccolo presente :)

i legend

Premium Member
ciao a tutti :)
ho realizzato un piccolo script , spero che possa tornare utili a qualcuno.
.P.s:
ho pensato di inserire in questo topic alcuni miei script personali o magari se leggo in giro qualche richiesta la inserisco qui dentro come raccoglitore, ovviamente se qualcuno riesce a migliorarli o ottimizzarli o ha suggerimenti sono ben accetti :)
intanto posto il primo script (statistica)
Mi raccomando sempre di controllare se si sono bugs( orrori ) e di segnalarli ed eventualmente cercare di risolverli
ancora buon natale a tutti :)
Codice:
Option Explicit
' controllare se si sono errori
' lo script in base a dei capogiochi scelti dall utente rivela
'frequenza,ritardo,ritardo massimo, differenza tra ritardo massimo e ritardo
'con i novanti abbinamenti
' vengono anche divisi e visti nel dettaglio le lunghette
Sub Main
   ' Inserire la voce Range Analisi
   Dim Ini,Fin
   Call ScegliRange(Ini,Fin,3950,EstrazioneFin)
   ReDim aR(0)
   Call ScegliRuote(aR)
   Dim nCap
   nCap = ScegliNumeroCapogiochi
   Select Case nCap
   Case 0
      Dim av:av = Array("Singolo+1Abbinamento","Singolo+2Abbinamenti")
      Dim idSing:idSing = ScegliOpzioneMenu(av,0,"SelezionaRicerca")
      If idSing = 0 Then
         Call ScegliSingolo(Ini,Fin,aR)
      Else
         Call ScegliSingoloDoppioAbb(Ini,Fin,aR)
      End If
   Case 1
      Call ScegliCoppia(Ini,Fin,aR)
   Case 2
      Call ScegliTerna(Ini,Fin,aR)
   End Select
End Sub
Function ScegliNumeroCapogiochi
   Dim aV:aV = Array(1,2,3)
   ScegliNumeroCapogiochi = ScegliOpzioneMenu(aV,0,"Seleziona Numero dei capogiochi")
End Function
Sub ScegliSingolo(Ini,Fin,Ar)
   Dim iCap1
   On Error Resume Next
   iCap1 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90","Scegli il Capogioco",""))
   If Not isNumeroValidoLotto(iCap1)Then
      Call MsgBox("Hai inserito un capogioco non valido",vbError,"Messaggio di errore")
      Exit Sub
   End If
   ' qui inserisco barra di testo
   Dim aEstratto:aEstratto = Array(0,iCap1)
   Dim iRit,iRitMax,iFreq,iScartoRit
   Call StatisticaFormazioneTurbo(aEstratto,Ar,1,iRit,iRitMax,0,iFreq,Ini,Fin)
   iScartoRit = iRitMax - iRit
   Scrivi FormatSpace(" ",194),,,RGB(0,128,255)
   Scrivi FormatSpace("  Statistica  1 capogioco + 1 abbinamento   ( studio Ambo )",194),1,,RGB(0,128,255),vbWhite
   Call SetColorSezione(RGB(198,207,222))'(RGB(210,219,234))
   Scrivi "   Ruota/e di analisi:  ",1,0
   Scrivi " " & FormatSpace(StringaRuote(Ar,,"-"),35,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(10) & "         Formazione Capogioco: ",1,0
   Scrivi " " & FormatSpace(StringaNumeri(aEstratto,,True),10,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(30) & "      Range Concorsi Analisi: ",1,0
   Scrivi " " & FormatSpace(Ini & "-" & Fin,15,1) & " ",1,,vbWhite
   Scrivi "  _____________________",1,,,RGB(250,250,250)
   Scrivi "__",1,0,,RGB(250,250,250)
   Scrivi " STATISTICA ESTRATTO ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi String(171,"_"),1,,,RGB(240,240,240)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Scrivi "   Ritardo Attuale:     ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRit,5,1) & " ",1,0,vbWhite
   Scrivi Space(46) & "Massimo Ritardo Storico: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRitMax,10,1) & " ",1,0,vbWhite ' ora sviluppo la ricerca
   Scrivi Space(44) & "     Frequenza: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iFreq,15,1) & " ",1,0,vbWhite
   Scrivi FormatSpace(" ",3),,,RGB(210,219,234)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Call SetColorSezione(RGB(255,255,255))
   Dim n,aAmbo,aCap1
   Dim RitAmb,RitAmbMax,FreqAmb,scaAmb
   Dim aTit:aTit = Array(0,"Ambo","RitAmbo","RitMaxAmbo","Sca_Ambo","FreqAmbo")
   Call InitTabella(aTit,vbWhite)
   For n = 1 To 90
      aAmbo = Array(0,iCap1,n)
      Call StatisticaFormazioneTurbo(aAmbo,Ar,2,RitAmb,RitAmbMax,0,FreqAmb,Ini,Fin)
      Dim aTab:aTab = Array(0,StringaNumeri(aAmbo,"-",True),RitAmb,RitAmbMax,RitAmbMax - RitAmb,FreqAmb)'
      Call AddRigaTabella(aTab)
      Call SetColoreCella(1,RGB(240,240,240),RGB(0,128,192))
      If NumeriRipetuti(aAmbo) Then
      Call ColoraCelleConRipetuti(1,aTab)
      End If

   Next ' n
   Call SetTableTitle("   STatistica Abbinamenti    |  Sca_ = (RitMax-Rit)",,,True,,,0)
   Call SetTableWidth("100%")
   Call SetTableHeight("286 pxz")
   Call CreaTabellaOrdinabile(5,- 1)
End Sub
Sub ScegliSingoloDoppioAbb(Ini,Fin,Ar)
   Dim iCap1
   On Error Resume Next
   iCap1 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90","Scegli il Capogioco",""))
   If Not isNumeroValidoLotto(iCap1)Then
      Call MsgBox("Hai inserito un capogioco non valido",vbError,"Messaggio di errore")
      Exit Sub
   End If
   ' qui inserisco barra di testo
   Dim aEstratto:aEstratto = Array(0,iCap1)
   Dim iRit,iRitMax,iFreq,iScartoRit
   Call StatisticaFormazioneTurbo(aEstratto,Ar,1,iRit,iRitMax,0,iFreq,Ini,Fin)
   iScartoRit = iRitMax - iRit
   Scrivi FormatSpace(" ",194),,,RGB(0,128,255)
   Scrivi FormatSpace("  Statistica  1 capogioco + 2 abbinamenti   ( studio Ambo )",194),1,,RGB(0,128,255),vbWhite
   Call SetColorSezione(RGB(198,207,222))'(RGB(210,219,234))
   Scrivi "   Ruota/e di analisi:  ",1,0
   Scrivi " " & FormatSpace(StringaRuote(Ar,,"-"),35,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(10) & "         Formazione Capogioco: ",1,0
   Scrivi " " & FormatSpace(StringaNumeri(aEstratto,,True),10,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(30) & "      Range Concorsi Analisi: ",1,0
   Scrivi " " & FormatSpace(Ini & "-" & Fin,15,1) & " ",1,,vbWhite
   Scrivi "  _____________________",1,,,RGB(250,250,250)
   Scrivi "__",1,0,,RGB(250,250,250)
   Scrivi " STATISTICA ESTRATTO ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi String(171,"_"),1,,,RGB(240,240,240)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Scrivi "   Ritardo Attuale:     ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRit,5,1) & " ",1,0,vbWhite
   Scrivi Space(46) & "Massimo Ritardo Storico: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRitMax,10,1) & " ",1,0,vbWhite ' ora sviluppo la ricerca
   Scrivi Space(44) & "     Frequenza: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iFreq,15,1) & " ",1,0,vbWhite
   Scrivi FormatSpace(" ",3),,,RGB(210,219,234)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Call SetColorSezione(RGB(255,255,255))
   Dim n1,n2,aTer,aAmb1,aAmb2
   Dim RitTr,RitTrMax,FreqTr,scaTr
   Dim RitCp1,RitCp1Max,FreqCp1,scaCp1
   Dim RitCp2,RitCp2Max,FreqCp2,scaCp2
   Dim aTit:aTit = Array(0,"Terzina","RitTr","RitMaxTr","Sca_Qr","FreqTr","Ambo1","RitAmb1","RitMaxAmb1","Sca_Amb1","FreqAmb1","Ambo2","RitAmb2","RitMaxAmb2","Sca_Amb2","FreqAmb2","Sum Freq")
   Call InitTabella(aTit)
   Dim K :K = 0
   For n1 = 1 To 89
      For n2 = n1 + 1 To 90
         aTer = Array(0,iCap1,n1,n2)
         aAmb1 = Array(0,iCap1,n1)
         aAmb2 = Array(0,iCap1,n2)
         Call StatisticaFormazioneTurbo(aTer,Ar,2,RitTr,RitTrMax,0,FreqTr,Ini,Fin)
         Call StatisticaFormazioneTurbo(aAmb1,Ar,2,RitCp1,RitCp1Max,0,FreqCp1,Ini,Fin)
         Call StatisticaFormazioneTurbo(aAmb2,Ar,2,RitCp2,RitCp2Max,0,FreqCp2,Ini,Fin)
         Dim aTab:aTab = Array(0,StringaNumeri(aTer,"-",True),RitTr,RitTrMax,RitTrMax - RitTr,FreqTr,StringaNumeri(aAmb1,"-",True),RitCp1,RitCp1Max,RitCp1Max - RitCp1,FreqCp1,StringaNumeri(aAmb2,"-",True),RitCp2,RitCp2Max,RitCp2Max - RitCp2,FreqCp2,FreqCp1 + FreqCp2)
         Call AddRigaTabella(aTab)
         Call SetColoreCella(1,RGB(240,240,240),RGB(0,128,192))
         If NumeriRipetuti(aTer) Then
            Call ColoraCelleConRipetuti(1,aTab)
         End If
         Call SetColoreCella(6,RGB(240,240,240),vbBlue)
         If NumeriRipetuti(aAmb1) Then
            Call ColoraCelleConRipetuti(6,aTab)
         End If
         Call SetColoreCella(11,RGB(240,240,240),vbRed)
         If NumeriRipetuti(aAmb2) Then
            Call ColoraCelleConRipetuti(11,aTab)
         End If
         Call SetColoreCella(16,RGB(255,212,125),RGB(30,57,91))
         K = K + 1
         Call AvanzamentoElab(1,4005,K)
      Next ' n2
   Next ' n1
   Call SetTableTitle("   STatistica Abbinamenti    |  Sca_ = (RitMax-Rit)",,,True,,,0)
   Call SetTableWidth("100%")
   Call SetTableHeight("286 pxz")
   Call CreaTabellaOrdinabile(16,- 1)
End Sub
Sub ScegliCoppia(Ini,Fin,Ar)
   Dim iCap1,iCap2
   On Error Resume Next
   iCap1 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90","Scegli il primo Capogioco",""))
   If Not isNumeroValidoLotto(iCap1)Then
      Call MsgBox("Hai inserito un capogioco non valido",vbError,"Messaggio di errore")
      Exit Sub
   Else
      iCap2 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90" & vbCrLf & "Diverso da : " & iCap1,"Scegli il secondo Capogioco",""))
      If(Not isNumeroValidoLotto(iCap2)) Or iCap1 = iCap2 Then
         Call MsgBox("il secondo  capogioco inserito non è valido",vbError,"Messaggio di errore")
         Exit Sub
      End If
   End If
   ' qui inserisco barra di testo
   Dim aAmbo:aAmbo = Array(0,iCap1,iCap2)
   Dim iRit,iRitMax,iFreq,iScartoRit
   Call StatisticaFormazioneTurbo(aAmbo,Ar,2,iRit,iRitMax,0,iFreq,Ini,Fin)
   iScartoRit = iRitMax - iRit
   Scrivi FormatSpace(" ",194),,,RGB(0,128,255)
   Scrivi FormatSpace("  Statistica  2 capogiochi + 1 abbinamento   ( studio Ambo )",194),1,,RGB(0,128,255),vbWhite
   Call SetColorSezione(RGB(198,207,222))'(RGB(210,219,234))
   Scrivi "   Ruota/e di analisi:  ",1,0
   Scrivi " " & FormatSpace(StringaRuote(Ar,,"-"),35,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(10) & "        Formazione Capogiochi: ",1,0
   Scrivi " " & FormatSpace(StringaNumeri(aAmbo,,True),10,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(30) & "      Range Concorsi Analisi: ",1,0
   Scrivi " " & FormatSpace(Ini & "-" & Fin,15,1) & " ",1,,vbWhite
   Scrivi "  _________________",1,,,RGB(250,250,250)
   Scrivi "__",1,0,,RGB(250,250,250)
   Scrivi " STATISTICA AMBO ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi String(175,"_"),1,,,RGB(240,240,240)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Scrivi "   Ritardo Attuale:     ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRit,5,1) & " ",1,0,vbWhite
   Scrivi Space(46) & "Massimo Ritardo Storico: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRitMax,10,1) & " ",1,0,vbWhite ' ora sviluppo la ricerca
   Scrivi Space(44) & "     Frequenza: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iFreq,15,1) & " ",1,0,vbWhite
   Scrivi FormatSpace(" ",3),,,RGB(210,219,234)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Call SetColorSezione(RGB(255,255,255))
   Dim n,aTerzina,aCap1,aCap2
   Dim RitTr,RitTrMax,FreqTr,scaTr
   Dim RitCp1,RitCp1Max,FreqCp1,scaCp1
   Dim RitCp2,RitCp2Max,FreqCp2,scaCp2
   Dim aTit:aTit = Array(0,"Terzina","RitTr","RitMaxTr","Sca_Tr","FreqTr","Cap1","RitCp1","RitMaxCp1","Sca_Cp1","FreqCp1","Cap2","RitCp2","RitMaxCp2","Sca_Cp2","FreqCp2","Sum Freq")
   Call InitTabella(aTit,vbWhite)
   For n = 1 To 90
      aTerzina = Array(0,iCap1,iCap2,n)
      aCap1 = Array(0,iCap1,n)
      aCap2 = Array(0,iCap2,n)
      Call StatisticaFormazioneTurbo(aTerzina,Ar,2,RitTr,RitTrMax,0,FreqTr,Ini,Fin)
      Call StatisticaFormazioneTurbo(aCap1,Ar,2,RitCp1,RitCp1Max,0,FreqCp1,Ini,Fin)
      Call StatisticaFormazioneTurbo(aCap2,Ar,2,RitCp2,RitCp2Max,0,FreqCp2,Ini,Fin)
      Dim aTab:aTab = Array(0,StringaNumeri(aTerzina,"-",True),RitTr,RitTrMax,RitTrMax - RitTr,FreqTr,StringaNumeri(aCap1,"-",True),RitCp1,RitCp1Max,RitCp1Max - RitCp1,FreqCp1,StringaNumeri(aCap2,"-",True),RitCp2,RitCp2Max,RitCp2Max - RitCp2,FreqCp2,FreqCp1 + FreqCp2)
      Call AddRigaTabella(aTab)
      Call SetColoreCella(1,RGB(240,240,240),RGB(0,128,192))
      If NumeriRipetuti(aTerzina) Then
      Call ColoraCelleConRipetuti(1,aTab)
      End If

      Call SetColoreCella(6,RGB(240,240,240),vbBlue)
      If NumeriRipetuti(aCap1) Then
      Call ColoraCelleConRipetuti(6,aTab)
      End If

      Call SetColoreCella(11,RGB(240,240,240),vbRed)
      If NumeriRipetuti(aCap2) Then
      Call ColoraCelleConRipetuti(11,aTab)
      End If

      Call SetColoreCella(16,RGB(255,212,125),RGB(30,57,91))
   Next ' n
   Call SetTableTitle("   STatistica Abbinamenti    |  Sca_ = (RitMax-Rit)",,,True,,,0)
   Call SetTableWidth("100%")
   Call SetTableHeight("286 pxz")
   Call CreaTabellaOrdinabile(16,- 1)
End Sub
Sub ScegliTerna(Ini,Fin,Ar)
   Dim iCap1,iCap2,iCap3
   On Error Resume Next
   iCap1 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90","Scegli il primo Capogioco",""))
   If Not isNumeroValidoLotto(iCap1)Then
      Call MsgBox("Hai inserito un capogioco non valido",vbError,"Messaggio di errore")
      Exit Sub
   Else
      iCap2 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90" & vbCrLf & "Diverso da : " & iCap1,"Scegli il secondo Capogioco",""))
      If(Not isNumeroValidoLotto(iCap2)) Or iCap1 = iCap2 Then
         Call MsgBox("il secondo  capogioco inserito non è valido",vbError,"Messaggio di errore")
         Exit Sub
      Else
         iCap3 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90" & vbCrLf & "Diverso da : " & iCap1 & "-" & iCap2,"Scegli il terzo Capogioco",""))
         If(Not isNumeroValidoLotto(iCap3)) Or(iCap3 = iCap1) Or(iCap3 = iCap1) Then
            Call MsgBox("il terzo  capogioco inserito non è valido",vbError,"Messaggio di errore")
            Exit Sub
         End If
      End If
   End If
   ' qui inserisco barra di testo
   Dim aTerno:aTerno = Array(0,iCap1,iCap2,iCap3)
   Dim iRit,iRitMax,iFreq,iScartoRit
   Call StatisticaFormazioneTurbo(aTerno,Ar,2,iRit,iRitMax,0,iFreq,Ini,Fin)
   iScartoRit = iRitMax - iRit
   Scrivi FormatSpace(" ",194),,,RGB(0,128,255)
   Scrivi FormatSpace("  Statistica  3 capogiochi + 1 abbinamento   ( studio Ambo )",194),1,,RGB(0,128,255),vbWhite
   Call SetColorSezione(RGB(198,207,222))'(RGB(210,219,234))
   Scrivi "   Ruota/e di analisi:  ",1,0
   Scrivi " " & FormatSpace(StringaRuote(Ar,,"-"),35,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(10) & "        Formazione Capogiochi: ",1,0
   Scrivi " " & FormatSpace(StringaNumeri(aTerno,,True),10,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(30) & "      Range Concorsi Analisi: ",1,0
   Scrivi " " & FormatSpace(Ini & "-" & Fin,15,1) & " ",1,,vbWhite
   Scrivi "  _________________",1,,,RGB(250,250,250)
   Scrivi "__",1,0,,RGB(250,250,250)
   Scrivi " STATISTICA AMBO ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi String(175,"_"),1,,,RGB(240,240,240)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Scrivi "   Ritardo Attuale:     ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRit,5,1) & " ",1,0,vbWhite
   Scrivi Space(46) & "Massimo Ritardo Storico: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRitMax,10,1) & " ",1,0,vbWhite ' ora sviluppo la ricerca
   Scrivi Space(44) & "     Frequenza: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iFreq,15,1) & " ",1,0,vbWhite
   Scrivi FormatSpace(" ",3),,,RGB(210,219,234)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Call SetColorSezione(RGB(255,255,255))
   Dim n,aQuartina,aCap1,aCap2,aCap3
   Dim RitQr,RitQrMax,FreqQr,scaQr
   Dim RitCp1,RitCp1Max,FreqCp1,scaCp1
   Dim RitCp2,RitCp2Max,FreqCp2,scaCp2
   Dim RitCp3,RitCp3Max,FreqCp3,scaCp3
   Dim aTit:aTit = Array(0,"Quartina","RitQr","RitMaxQr","Sca_Qr","FreqQr","Cap1","RitCp1","RitMaxCp1","Sca_Cp1","FreqCp1","Cap2","RitCp2","RitMaxCp2","Sca_Cp2","FreqCp2","Cap3","RitCp3","RitMaxCp3","Sca_Cp3","FreqCp3","Sum Freq")
   Call InitTabella(aTit)
   For n = 1 To 90
      aQuartina = Array(0,iCap1,iCap2,iCap3,n)
      aCap1 = Array(0,iCap1,n)
      aCap2 = Array(0,iCap2,n)
      aCap3 = Array(0,iCap3,n)
      Call StatisticaFormazioneTurbo(aQuartina,Ar,2,RitQr,RitQrMax,0,FreqQr,Ini,Fin)
      Call StatisticaFormazioneTurbo(aCap1,Ar,2,RitCp1,RitCp1Max,0,FreqCp1,Ini,Fin)
      Call StatisticaFormazioneTurbo(aCap2,Ar,2,RitCp2,RitCp2Max,0,FreqCp2,Ini,Fin)
      Call StatisticaFormazioneTurbo(aCap3,Ar,2,RitCp3,RitCp3Max,0,FreqCp3,Ini,Fin)
      Dim aTab:aTab = Array(0,StringaNumeri(aQuartina,"-",True),RitQr,RitQrMax,RitQrMax - RitQr,FreqQr,StringaNumeri(aCap1,"-",True),RitCp1,RitCp1Max,RitCp1Max - RitCp1,FreqCp1,StringaNumeri(aCap2,"-",True),RitCp2,RitCp2Max,RitCp2Max - RitCp2,FreqCp2,StringaNumeri(aCap3,"-",True),RitCp3,RitCp3Max,RitCp3Max - RitCp3,FreqCp3,FreqCp1 + FreqCp2 + FreqCp3)
      Call AddRigaTabella(aTab)
      Call SetColoreCella(1,RGB(240,240,240),RGB(0,128,192))
      If NumeriRipetuti(aQuartina) Then
      Call ColoraCelleConRipetuti(1,aTab)
      End If

      Call SetColoreCella(6,RGB(240,240,240),vbBlue)
      If NumeriRipetuti(aCap1) Then
      Call ColoraCelleConRipetuti(6,aTab)
      End If

      Call SetColoreCella(11,RGB(240,240,240),vbRed)
      If NumeriRipetuti(aCap2) Then
      Call ColoraCelleConRipetuti(11,aTab)
      End If

      Call SetColoreCella(16,RGB(240,240,240),vbMagenta)
      If NumeriRipetuti(aCap3) Then
      Call ColoraCelleConRipetuti(16,aTab)
      End If

      Call SetColoreCella(21,RGB(255,212,125),RGB(30,57,91))
   Next ' n
   Call SetTableTitle("   STatistica Abbinamenti    |  Sca_ = (RitMax-Rit)",,,True,,,0)
   Call SetTableWidth("100%")
   Call SetTableHeight("286 pxz")
   Call CreaTabellaOrdinabile(21,- 1)
End Sub
Function ColoraCelleConRipetuti(N,aTab)
   Dim i
   For i = N To N + 5
      Call SetColoreCella(Int(i),RGB(255,98,98))
   Next
End Function
 

vincenzo4221

Advanced Member >PLATINUM<
Ciao legend e Buon Santo Stefano , ho fatto delle richieste per script di analisi su basi statistiche (con logica razionale)..penso che potresti darmi una mano...
 

i legend

Premium Member
Buon Santo Stefano a tutti.
Grazie a chi è passato da qui e ha lasciato un segno della sua presenza ???
X Vincenzo.
Al momento sto preparando e riscrivendo vecchi script.
Se trovo tempo vedrò di fare anche cose nuove..
Ciao a tutti:)
ADVERTISEMENT​
 

Alien.

Advanced Premium Member
Ciao i legend dato che hai fatto un piccolo script che sembra un papiro,cosa ne pensi di uno script che mi dica in modo molto approssimativo inserendo un numero la sua probabile uscita in una ruota determinata da input ? cosa ne dici ? si lo so non sei un -"mago"...ma.....poco ci manca hahahhaahah :p :p :p
 
Ultima modifica:

i legend

Premium Member
Ciao a tutti:)
Nel tempo libero sto cercando di trasformare un vecchio script ma non è una cosa facile sopratutto per i tempi di elaborazione .
X alien
Hai ragione : non sono un mago.:)
Se esistesse un algoritmo del genere non esisterebbe più questo gioco.
Spero di riuscire a fare qualcosa oggi.
 

Asuniverso

Advanced Member >PLATINUM PLUS<
ciao a tutti :)
ho realizzato un piccolo script , spero che possa tornare utili a qualcuno.
.P.s:
ho pensato di inserire in questo topic alcuni miei script personali o magari se leggo in giro qualche richiesta la inserisco qui dentro come raccoglitore, ovviamente se qualcuno riesce a migliorarli o ottimizzarli o ha suggerimenti sono ben accetti :)
intanto posto il primo script (statistica)
Mi raccomando sempre di controllare se si sono bugs( orrori ) e di segnalarli ed eventualmente cercare di risolverli
ancora buon natale a tutti :)
Codice:
Option Explicit
' controllare se si sono errori
' lo script in base a dei capogiochi scelti dall utente rivela
'frequenza,ritardo,ritardo massimo, differenza tra ritardo massimo e ritardo
'con i novanti abbinamenti
' vengono anche divisi e visti nel dettaglio le lunghette
Sub Main
   ' Inserire la voce Range Analisi
   Dim Ini,Fin
   Call ScegliRange(Ini,Fin,3950,EstrazioneFin)
   ReDim aR(0)
   Call ScegliRuote(aR)
   Dim nCap
   nCap = ScegliNumeroCapogiochi
   Select Case nCap
   Case 0
      Dim av:av = Array("Singolo+1Abbinamento","Singolo+2Abbinamenti")
      Dim idSing:idSing = ScegliOpzioneMenu(av,0,"SelezionaRicerca")
      If idSing = 0 Then
         Call ScegliSingolo(Ini,Fin,aR)
      Else
         Call ScegliSingoloDoppioAbb(Ini,Fin,aR)
      End If
   Case 1
      Call ScegliCoppia(Ini,Fin,aR)
   Case 2
      Call ScegliTerna(Ini,Fin,aR)
   End Select
End Sub
Function ScegliNumeroCapogiochi
   Dim aV:aV = Array(1,2,3)
   ScegliNumeroCapogiochi = ScegliOpzioneMenu(aV,0,"Seleziona Numero dei capogiochi")
End Function
Sub ScegliSingolo(Ini,Fin,Ar)
   Dim iCap1
   On Error Resume Next
   iCap1 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90","Scegli il Capogioco",""))
   If Not isNumeroValidoLotto(iCap1)Then
      Call MsgBox("Hai inserito un capogioco non valido",vbError,"Messaggio di errore")
      Exit Sub
   End If
   ' qui inserisco barra di testo
   Dim aEstratto:aEstratto = Array(0,iCap1)
   Dim iRit,iRitMax,iFreq,iScartoRit
   Call StatisticaFormazioneTurbo(aEstratto,Ar,1,iRit,iRitMax,0,iFreq,Ini,Fin)
   iScartoRit = iRitMax - iRit
   Scrivi FormatSpace(" ",194),,,RGB(0,128,255)
   Scrivi FormatSpace("  Statistica  1 capogioco + 1 abbinamento   ( studio Ambo )",194),1,,RGB(0,128,255),vbWhite
   Call SetColorSezione(RGB(198,207,222))'(RGB(210,219,234))
   Scrivi "   Ruota/e di analisi:  ",1,0
   Scrivi " " & FormatSpace(StringaRuote(Ar,,"-"),35,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(10) & "         Formazione Capogioco: ",1,0
   Scrivi " " & FormatSpace(StringaNumeri(aEstratto,,True),10,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(30) & "      Range Concorsi Analisi: ",1,0
   Scrivi " " & FormatSpace(Ini & "-" & Fin,15,1) & " ",1,,vbWhite
   Scrivi "  _____________________",1,,,RGB(250,250,250)
   Scrivi "__",1,0,,RGB(250,250,250)
   Scrivi " STATISTICA ESTRATTO ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi String(171,"_"),1,,,RGB(240,240,240)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Scrivi "   Ritardo Attuale:     ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRit,5,1) & " ",1,0,vbWhite
   Scrivi Space(46) & "Massimo Ritardo Storico: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRitMax,10,1) & " ",1,0,vbWhite ' ora sviluppo la ricerca
   Scrivi Space(44) & "     Frequenza: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iFreq,15,1) & " ",1,0,vbWhite
   Scrivi FormatSpace(" ",3),,,RGB(210,219,234)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Call SetColorSezione(RGB(255,255,255))
   Dim n,aAmbo,aCap1
   Dim RitAmb,RitAmbMax,FreqAmb,scaAmb
   Dim aTit:aTit = Array(0,"Ambo","RitAmbo","RitMaxAmbo","Sca_Ambo","FreqAmbo")
   Call InitTabella(aTit,vbWhite)
   For n = 1 To 90
      aAmbo = Array(0,iCap1,n)
      Call StatisticaFormazioneTurbo(aAmbo,Ar,2,RitAmb,RitAmbMax,0,FreqAmb,Ini,Fin)
      Dim aTab:aTab = Array(0,StringaNumeri(aAmbo,"-",True),RitAmb,RitAmbMax,RitAmbMax - RitAmb,FreqAmb)'
      Call AddRigaTabella(aTab)
      Call SetColoreCella(1,RGB(240,240,240),RGB(0,128,192))
      If NumeriRipetuti(aAmbo) Then
      Call ColoraCelleConRipetuti(1,aTab)
      End If

   Next ' n
   Call SetTableTitle("   STatistica Abbinamenti    |  Sca_ = (RitMax-Rit)",,,True,,,0)
   Call SetTableWidth("100%")
   Call SetTableHeight("286 pxz")
   Call CreaTabellaOrdinabile(5,- 1)
End Sub
Sub ScegliSingoloDoppioAbb(Ini,Fin,Ar)
   Dim iCap1
   On Error Resume Next
   iCap1 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90","Scegli il Capogioco",""))
   If Not isNumeroValidoLotto(iCap1)Then
      Call MsgBox("Hai inserito un capogioco non valido",vbError,"Messaggio di errore")
      Exit Sub
   End If
   ' qui inserisco barra di testo
   Dim aEstratto:aEstratto = Array(0,iCap1)
   Dim iRit,iRitMax,iFreq,iScartoRit
   Call StatisticaFormazioneTurbo(aEstratto,Ar,1,iRit,iRitMax,0,iFreq,Ini,Fin)
   iScartoRit = iRitMax - iRit
   Scrivi FormatSpace(" ",194),,,RGB(0,128,255)
   Scrivi FormatSpace("  Statistica  1 capogioco + 2 abbinamenti   ( studio Ambo )",194),1,,RGB(0,128,255),vbWhite
   Call SetColorSezione(RGB(198,207,222))'(RGB(210,219,234))
   Scrivi "   Ruota/e di analisi:  ",1,0
   Scrivi " " & FormatSpace(StringaRuote(Ar,,"-"),35,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(10) & "         Formazione Capogioco: ",1,0
   Scrivi " " & FormatSpace(StringaNumeri(aEstratto,,True),10,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(30) & "      Range Concorsi Analisi: ",1,0
   Scrivi " " & FormatSpace(Ini & "-" & Fin,15,1) & " ",1,,vbWhite
   Scrivi "  _____________________",1,,,RGB(250,250,250)
   Scrivi "__",1,0,,RGB(250,250,250)
   Scrivi " STATISTICA ESTRATTO ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi String(171,"_"),1,,,RGB(240,240,240)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Scrivi "   Ritardo Attuale:     ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRit,5,1) & " ",1,0,vbWhite
   Scrivi Space(46) & "Massimo Ritardo Storico: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRitMax,10,1) & " ",1,0,vbWhite ' ora sviluppo la ricerca
   Scrivi Space(44) & "     Frequenza: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iFreq,15,1) & " ",1,0,vbWhite
   Scrivi FormatSpace(" ",3),,,RGB(210,219,234)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Call SetColorSezione(RGB(255,255,255))
   Dim n1,n2,aTer,aAmb1,aAmb2
   Dim RitTr,RitTrMax,FreqTr,scaTr
   Dim RitCp1,RitCp1Max,FreqCp1,scaCp1
   Dim RitCp2,RitCp2Max,FreqCp2,scaCp2
   Dim aTit:aTit = Array(0,"Terzina","RitTr","RitMaxTr","Sca_Qr","FreqTr","Ambo1","RitAmb1","RitMaxAmb1","Sca_Amb1","FreqAmb1","Ambo2","RitAmb2","RitMaxAmb2","Sca_Amb2","FreqAmb2","Sum Freq")
   Call InitTabella(aTit)
   Dim K :K = 0
   For n1 = 1 To 89
      For n2 = n1 + 1 To 90
         aTer = Array(0,iCap1,n1,n2)
         aAmb1 = Array(0,iCap1,n1)
         aAmb2 = Array(0,iCap1,n2)
         Call StatisticaFormazioneTurbo(aTer,Ar,2,RitTr,RitTrMax,0,FreqTr,Ini,Fin)
         Call StatisticaFormazioneTurbo(aAmb1,Ar,2,RitCp1,RitCp1Max,0,FreqCp1,Ini,Fin)
         Call StatisticaFormazioneTurbo(aAmb2,Ar,2,RitCp2,RitCp2Max,0,FreqCp2,Ini,Fin)
         Dim aTab:aTab = Array(0,StringaNumeri(aTer,"-",True),RitTr,RitTrMax,RitTrMax - RitTr,FreqTr,StringaNumeri(aAmb1,"-",True),RitCp1,RitCp1Max,RitCp1Max - RitCp1,FreqCp1,StringaNumeri(aAmb2,"-",True),RitCp2,RitCp2Max,RitCp2Max - RitCp2,FreqCp2,FreqCp1 + FreqCp2)
         Call AddRigaTabella(aTab)
         Call SetColoreCella(1,RGB(240,240,240),RGB(0,128,192))
         If NumeriRipetuti(aTer) Then
            Call ColoraCelleConRipetuti(1,aTab)
         End If
         Call SetColoreCella(6,RGB(240,240,240),vbBlue)
         If NumeriRipetuti(aAmb1) Then
            Call ColoraCelleConRipetuti(6,aTab)
         End If
         Call SetColoreCella(11,RGB(240,240,240),vbRed)
         If NumeriRipetuti(aAmb2) Then
            Call ColoraCelleConRipetuti(11,aTab)
         End If
         Call SetColoreCella(16,RGB(255,212,125),RGB(30,57,91))
         K = K + 1
         Call AvanzamentoElab(1,4005,K)
      Next ' n2
   Next ' n1
   Call SetTableTitle("   STatistica Abbinamenti    |  Sca_ = (RitMax-Rit)",,,True,,,0)
   Call SetTableWidth("100%")
   Call SetTableHeight("286 pxz")
   Call CreaTabellaOrdinabile(16,- 1)
End Sub
Sub ScegliCoppia(Ini,Fin,Ar)
   Dim iCap1,iCap2
   On Error Resume Next
   iCap1 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90","Scegli il primo Capogioco",""))
   If Not isNumeroValidoLotto(iCap1)Then
      Call MsgBox("Hai inserito un capogioco non valido",vbError,"Messaggio di errore")
      Exit Sub
   Else
      iCap2 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90" & vbCrLf & "Diverso da : " & iCap1,"Scegli il secondo Capogioco",""))
      If(Not isNumeroValidoLotto(iCap2)) Or iCap1 = iCap2 Then
         Call MsgBox("il secondo  capogioco inserito non è valido",vbError,"Messaggio di errore")
         Exit Sub
      End If
   End If
   ' qui inserisco barra di testo
   Dim aAmbo:aAmbo = Array(0,iCap1,iCap2)
   Dim iRit,iRitMax,iFreq,iScartoRit
   Call StatisticaFormazioneTurbo(aAmbo,Ar,2,iRit,iRitMax,0,iFreq,Ini,Fin)
   iScartoRit = iRitMax - iRit
   Scrivi FormatSpace(" ",194),,,RGB(0,128,255)
   Scrivi FormatSpace("  Statistica  2 capogiochi + 1 abbinamento   ( studio Ambo )",194),1,,RGB(0,128,255),vbWhite
   Call SetColorSezione(RGB(198,207,222))'(RGB(210,219,234))
   Scrivi "   Ruota/e di analisi:  ",1,0
   Scrivi " " & FormatSpace(StringaRuote(Ar,,"-"),35,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(10) & "        Formazione Capogiochi: ",1,0
   Scrivi " " & FormatSpace(StringaNumeri(aAmbo,,True),10,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(30) & "      Range Concorsi Analisi: ",1,0
   Scrivi " " & FormatSpace(Ini & "-" & Fin,15,1) & " ",1,,vbWhite
   Scrivi "  _________________",1,,,RGB(250,250,250)
   Scrivi "__",1,0,,RGB(250,250,250)
   Scrivi " STATISTICA AMBO ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi String(175,"_"),1,,,RGB(240,240,240)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Scrivi "   Ritardo Attuale:     ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRit,5,1) & " ",1,0,vbWhite
   Scrivi Space(46) & "Massimo Ritardo Storico: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRitMax,10,1) & " ",1,0,vbWhite ' ora sviluppo la ricerca
   Scrivi Space(44) & "     Frequenza: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iFreq,15,1) & " ",1,0,vbWhite
   Scrivi FormatSpace(" ",3),,,RGB(210,219,234)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Call SetColorSezione(RGB(255,255,255))
   Dim n,aTerzina,aCap1,aCap2
   Dim RitTr,RitTrMax,FreqTr,scaTr
   Dim RitCp1,RitCp1Max,FreqCp1,scaCp1
   Dim RitCp2,RitCp2Max,FreqCp2,scaCp2
   Dim aTit:aTit = Array(0,"Terzina","RitTr","RitMaxTr","Sca_Tr","FreqTr","Cap1","RitCp1","RitMaxCp1","Sca_Cp1","FreqCp1","Cap2","RitCp2","RitMaxCp2","Sca_Cp2","FreqCp2","Sum Freq")
   Call InitTabella(aTit,vbWhite)
   For n = 1 To 90
      aTerzina = Array(0,iCap1,iCap2,n)
      aCap1 = Array(0,iCap1,n)
      aCap2 = Array(0,iCap2,n)
      Call StatisticaFormazioneTurbo(aTerzina,Ar,2,RitTr,RitTrMax,0,FreqTr,Ini,Fin)
      Call StatisticaFormazioneTurbo(aCap1,Ar,2,RitCp1,RitCp1Max,0,FreqCp1,Ini,Fin)
      Call StatisticaFormazioneTurbo(aCap2,Ar,2,RitCp2,RitCp2Max,0,FreqCp2,Ini,Fin)
      Dim aTab:aTab = Array(0,StringaNumeri(aTerzina,"-",True),RitTr,RitTrMax,RitTrMax - RitTr,FreqTr,StringaNumeri(aCap1,"-",True),RitCp1,RitCp1Max,RitCp1Max - RitCp1,FreqCp1,StringaNumeri(aCap2,"-",True),RitCp2,RitCp2Max,RitCp2Max - RitCp2,FreqCp2,FreqCp1 + FreqCp2)
      Call AddRigaTabella(aTab)
      Call SetColoreCella(1,RGB(240,240,240),RGB(0,128,192))
      If NumeriRipetuti(aTerzina) Then
      Call ColoraCelleConRipetuti(1,aTab)
      End If

      Call SetColoreCella(6,RGB(240,240,240),vbBlue)
      If NumeriRipetuti(aCap1) Then
      Call ColoraCelleConRipetuti(6,aTab)
      End If

      Call SetColoreCella(11,RGB(240,240,240),vbRed)
      If NumeriRipetuti(aCap2) Then
      Call ColoraCelleConRipetuti(11,aTab)
      End If

      Call SetColoreCella(16,RGB(255,212,125),RGB(30,57,91))
   Next ' n
   Call SetTableTitle("   STatistica Abbinamenti    |  Sca_ = (RitMax-Rit)",,,True,,,0)
   Call SetTableWidth("100%")
   Call SetTableHeight("286 pxz")
   Call CreaTabellaOrdinabile(16,- 1)
End Sub
Sub ScegliTerna(Ini,Fin,Ar)
   Dim iCap1,iCap2,iCap3
   On Error Resume Next
   iCap1 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90","Scegli il primo Capogioco",""))
   If Not isNumeroValidoLotto(iCap1)Then
      Call MsgBox("Hai inserito un capogioco non valido",vbError,"Messaggio di errore")
      Exit Sub
   Else
      iCap2 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90" & vbCrLf & "Diverso da : " & iCap1,"Scegli il secondo Capogioco",""))
      If(Not isNumeroValidoLotto(iCap2)) Or iCap1 = iCap2 Then
         Call MsgBox("il secondo  capogioco inserito non è valido",vbError,"Messaggio di errore")
         Exit Sub
      Else
         iCap3 = CInt(InputBox("Inserisci un numero compreso tra" & vbCrLf & " 1 e 90" & vbCrLf & "Diverso da : " & iCap1 & "-" & iCap2,"Scegli il terzo Capogioco",""))
         If(Not isNumeroValidoLotto(iCap3)) Or(iCap3 = iCap1) Or(iCap3 = iCap1) Then
            Call MsgBox("il terzo  capogioco inserito non è valido",vbError,"Messaggio di errore")
            Exit Sub
         End If
      End If
   End If
   ' qui inserisco barra di testo
   Dim aTerno:aTerno = Array(0,iCap1,iCap2,iCap3)
   Dim iRit,iRitMax,iFreq,iScartoRit
   Call StatisticaFormazioneTurbo(aTerno,Ar,2,iRit,iRitMax,0,iFreq,Ini,Fin)
   iScartoRit = iRitMax - iRit
   Scrivi FormatSpace(" ",194),,,RGB(0,128,255)
   Scrivi FormatSpace("  Statistica  3 capogiochi + 1 abbinamento   ( studio Ambo )",194),1,,RGB(0,128,255),vbWhite
   Call SetColorSezione(RGB(198,207,222))'(RGB(210,219,234))
   Scrivi "   Ruota/e di analisi:  ",1,0
   Scrivi " " & FormatSpace(StringaRuote(Ar,,"-"),35,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(10) & "        Formazione Capogiochi: ",1,0
   Scrivi " " & FormatSpace(StringaNumeri(aTerno,,True),10,1) & " ",1,0,vbWhite,RGB(0,123,183)
   Scrivi Space(30) & "      Range Concorsi Analisi: ",1,0
   Scrivi " " & FormatSpace(Ini & "-" & Fin,15,1) & " ",1,,vbWhite
   Scrivi "  _________________",1,,,RGB(250,250,250)
   Scrivi "__",1,0,,RGB(250,250,250)
   Scrivi " STATISTICA AMBO ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi String(175,"_"),1,,,RGB(240,240,240)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Scrivi "   Ritardo Attuale:     ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRit,5,1) & " ",1,0,vbWhite
   Scrivi Space(46) & "Massimo Ritardo Storico: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iRitMax,10,1) & " ",1,0,vbWhite ' ora sviluppo la ricerca
   Scrivi Space(44) & "     Frequenza: ",1,0,RGB(210,219,234),RGB(0,123,183)
   Scrivi " " & FormatSpace(iFreq,15,1) & " ",1,0,vbWhite
   Scrivi FormatSpace(" ",3),,,RGB(210,219,234)
   Scrivi FormatSpace(" ",194),,,RGB(210,219,234)
   Call SetColorSezione(RGB(255,255,255))
   Dim n,aQuartina,aCap1,aCap2,aCap3
   Dim RitQr,RitQrMax,FreqQr,scaQr
   Dim RitCp1,RitCp1Max,FreqCp1,scaCp1
   Dim RitCp2,RitCp2Max,FreqCp2,scaCp2
   Dim RitCp3,RitCp3Max,FreqCp3,scaCp3
   Dim aTit:aTit = Array(0,"Quartina","RitQr","RitMaxQr","Sca_Qr","FreqQr","Cap1","RitCp1","RitMaxCp1","Sca_Cp1","FreqCp1","Cap2","RitCp2","RitMaxCp2","Sca_Cp2","FreqCp2","Cap3","RitCp3","RitMaxCp3","Sca_Cp3","FreqCp3","Sum Freq")
   Call InitTabella(aTit)
   For n = 1 To 90
      aQuartina = Array(0,iCap1,iCap2,iCap3,n)
      aCap1 = Array(0,iCap1,n)
      aCap2 = Array(0,iCap2,n)
      aCap3 = Array(0,iCap3,n)
      Call StatisticaFormazioneTurbo(aQuartina,Ar,2,RitQr,RitQrMax,0,FreqQr,Ini,Fin)
      Call StatisticaFormazioneTurbo(aCap1,Ar,2,RitCp1,RitCp1Max,0,FreqCp1,Ini,Fin)
      Call StatisticaFormazioneTurbo(aCap2,Ar,2,RitCp2,RitCp2Max,0,FreqCp2,Ini,Fin)
      Call StatisticaFormazioneTurbo(aCap3,Ar,2,RitCp3,RitCp3Max,0,FreqCp3,Ini,Fin)
      Dim aTab:aTab = Array(0,StringaNumeri(aQuartina,"-",True),RitQr,RitQrMax,RitQrMax - RitQr,FreqQr,StringaNumeri(aCap1,"-",True),RitCp1,RitCp1Max,RitCp1Max - RitCp1,FreqCp1,StringaNumeri(aCap2,"-",True),RitCp2,RitCp2Max,RitCp2Max - RitCp2,FreqCp2,StringaNumeri(aCap3,"-",True),RitCp3,RitCp3Max,RitCp3Max - RitCp3,FreqCp3,FreqCp1 + FreqCp2 + FreqCp3)
      Call AddRigaTabella(aTab)
      Call SetColoreCella(1,RGB(240,240,240),RGB(0,128,192))
      If NumeriRipetuti(aQuartina) Then
      Call ColoraCelleConRipetuti(1,aTab)
      End If

      Call SetColoreCella(6,RGB(240,240,240),vbBlue)
      If NumeriRipetuti(aCap1) Then
      Call ColoraCelleConRipetuti(6,aTab)
      End If

      Call SetColoreCella(11,RGB(240,240,240),vbRed)
      If NumeriRipetuti(aCap2) Then
      Call ColoraCelleConRipetuti(11,aTab)
      End If

      Call SetColoreCella(16,RGB(240,240,240),vbMagenta)
      If NumeriRipetuti(aCap3) Then
      Call ColoraCelleConRipetuti(16,aTab)
      End If

      Call SetColoreCella(21,RGB(255,212,125),RGB(30,57,91))
   Next ' n
   Call SetTableTitle("   STatistica Abbinamenti    |  Sca_ = (RitMax-Rit)",,,True,,,0)
   Call SetTableWidth("100%")
   Call SetTableHeight("286 pxz")
   Call CreaTabellaOrdinabile(21,- 1)
End Sub
Function ColoraCelleConRipetuti(N,aTab)
   Dim i
   For i = N To N + 5
      Call SetColoreCella(Int(i),RGB(255,98,98))
   Next
End Function

Ti ringrazio i legend leggo ora il tuo post e trovo lo script di mio gradimento! Gentilissimo ciao.
 

i legend

Premium Member
Ciao a tutti , ringrazio tutti:)
Sto realizzando un altro piccolo script, ma riesco a lavorarci pochissimo ,causa stanchezza.
Intanto auguro un felice anno nuovo a tutti :)
Un abbraccio agli amici :)
 

toon

Advanced Member
Ottimo "I Legend" Script utilissimo.
Auguri di un ottimo 2020 a Tutti. Se il detto "chi ha venti ha vinto" è vero, l'anno promette bene....
;)(y)
 

i legend

Premium Member
ciao a tutti
ecco a voi un altro script con funzioni alternative al tabellone statistico
ci sono vari colri che aiutano a visualizzare velocemente alcuni dati
posto lo script , controllate che funzionino
Codice:
Option Explicit
Sub Main
   Dim Quest
   Quest = MsgBox("Verificare che i dati riportati siano esatti" & vbCrLf & "Non se ne garantisce la correttezza" & vbCrLf & "Vuoi proseguire?",4 + 64,"Informazioni")
   If Quest = 7 Then Exit Sub
   Dim IdEstr,Ini,M,E,P,Rit,sE,Pres,QT,qNR,sca,nEstr
   Dim acolC(2)
   Dim R
   Dim aPiuRit(11)
   For R = 1 To 12
      If R = 11 Then R = 12
      M = M + 1
      aPiuRit(M) = EstrattoRitardoTurbo(R,PiuRitardatarioTurbo(EstrazioneFin,R))
   Next
   Dim qE:qE = MassimoV(aPiuRit)
   Ini = EstrazioneFin - qE
   qE = - 1
   '
   Call GetTestoTab
   M = 0
   acolC(1) = vbWhite
   For IdEstr = EstrazioneFin To Ini Step - 1
      qE = qE + 1
      Scrivi IdEstr,1,0,RGB(235,235,255)
      Scrivi "|",,0,vbWhite,RGB(89,89,89)
      Scrivi FormattaStringa(qE,"000"),,0,RGB(237,254,205),RGB(128,0,0)
      Scrivi "|",1,0,vbWhite,,3
      Pres = 0:M = 0
      QT = Round(QuantitaTeoricaCombAlRitX(qE),5)
      For R = 1 To 12
         If dispari(R) Then acolC(1) = vbWhite:acolC(2) = RGB(0,101,149):Else acolC(1) = vbWhite:acolC(2) = RGB(38,40,37)
         If R = 11 Then R = 12
         M = M + 1
         sE = "":nEstr = 0
         For P = 1 To 5
            E = Estratto(IdEstr,R,P)
            Rit = EstrattoRitardoTurbo(R,E)
            If Rit = qE Then E = Format2(E) :Pres = Pres + 1:nEstr = nEstr + 1:Else E = ".."
            sE = sE & E & " "
         Next
         sE = RimuoviLastChr(sE," ")
         If nEstr > QT And qE <> aPiuRit(M) Then
            acolC(1) = RGB(209,209,236)
         ElseIf qE = aPiuRit(M) Then
            acolC(1) = RGB(255,196,196)
         End If
         Scrivi sE,,0,acolC(1),acolC(2)
         Scrivi "|",,0,vbWhite,RGB(89,89,89)
      Next
      qNR = Round(QT*11,3)
      sca = Round(Pres - qNR,2)
      If sca > 0 Then sca = "+" & sca
      Scrivi "  " & Format2(Pres) & "  ",1,0,RGB(211,250,245)
      Scrivi "|",,0
      Scrivi FormatSpace(qNR,6,1) & "  ",,0,RGB(255,217,217)
      Scrivi "|",,0
      If sca < 0 Then
         Scrivi FormatSpace(sca,5,1),,,RGB(255,117,117),vbWhite
      ElseIf sca >= 0 And sca < 5 Then
         Scrivi FormatSpace(sca,5,1),,,RGB(171,171,214),vbWhite
      Else
         Scrivi FormatSpace(sca,5,1),1,,RGB(145,223,147)
      End If
   Next
End Sub
Sub GetTestoTab
   Dim R,p
   Scrivi "    |   |",,0,RGB(249,249,249)
   For R = 1 To 12
      If R = 11 Then R = 12
      Scrivi Space(14) & "|",,0,RGB(249,249,249)
   Next
   Scrivi "                     ",,,RGB(254,248,182)
   Scrivi "CONC|R.C|",,0,RGB(247,247,247)
   For R = 1 To 12
      If R = 11 Then R = 12
      Scrivi Space(6) & SiglaRuota(R) & Space(6) & "|",,0,RGB(247,247,247)
   Next
   Scrivi "  Q.N |  Q.T   | SCT ",,,RGB(254,247,158)
   Scrivi "    |   |",,0,RGB(245,245,245)
   For R = 1 To 12
      If R = 11 Then R = 12
      Scrivi Space(14) & "|",,0,RGB(245,245,245)
   Next
   Scrivi "                     ",,,RGB(254,245,139)
End Sub
ciao a tutti e fatemi sapere se funzia ;)
altri script arriveranno prossimamente :)
 

toon

Advanced Member
lotto_tom75 Tabellone-analitico-intelligente-by-ilegend.ls è il nome più indicato.
Molto utile, la ricerca visuale è comodissima. Complimenti e Grazie.
 

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 16 marzo 2024
    Bari
    17
    57
    87
    39
    24
    Cagliari
    09
    59
    12
    08
    63
    Firenze
    13
    73
    41
    43
    17
    Genova
    06
    58
    10
    37
    62
    Milano
    43
    71
    21
    85
    23
    Napoli
    89
    66
    11
    44
    14
    Palermo
    87
    23
    13
    46
    45
    Roma
    89
    08
    43
    68
    55
    Torino
    32
    52
    11
    39
    65
    Venezia
    78
    65
    16
    27
    21
    Nazionale
    78
    16
    44
    60
    28
    Estrazione Simbolotto
    Firenze
    18
    31
    43
    30
    45
Alto