Novità

un piccolo presente :)

i legend

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
 

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

Advanced Member >PLATINUM PLUS<
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

Advanced Member >PLATINUM PLUS<
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

Super Member >PLATINUM<
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

Advanced Member >PLATINUM PLUS<
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 :)
 

Serpico 90

Advanced Member
I LEGEND....grazie del lavoro che realizzi per noi........
Ti auguro un sereno e proficuo....anno 2020
buon proseguimento
 

toon

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

Advanced Member >PLATINUM PLUS<
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

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
    Tuesday 27 October 2020
    Bari
    88
    72
    12
    87
    49
    Cagliari
    22
    20
    56
    59
    30
    Firenze
    05
    39
    74
    53
    86
    Genova
    57
    72
    07
    46
    02
    Milano
    88
    40
    30
    33
    38
    Napoli
    23
    14
    11
    90
    20
    Palermo
    12
    18
    89
    06
    20
    Roma
    76
    03
    45
    20
    44
    Torino
    64
    30
    43
    69
    16
    Venezia
    56
    60
    32
    17
    46
    Nazionale
    59
    74
    12
    50
    54
    Estrazione Simbolotto
    12
    25
    26
    23
    13

Ultimi Messaggi

Alto