un piccolo presente :)

i legend · 25 Dicembre 2019

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 · 26 Dicembre 2019

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...

vincenzo4221 · 26 Dicembre 2019

Bellissimo ed utilissimo lo script di cui sopra

Alien. · 26 Dicembre 2019

ottimo.

i legend · 26 Dicembre 2019

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

chicco3 · 26 Dicembre 2019

Ottimo i legend Auguri.

Alien. · 28 Dicembre 2019

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

i legend · 29 Dicembre 2019

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 · 2 Gennaio 2020

i legend ha scritto:

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 · 2 Gennaio 2020

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

Ciao ,non c e' di che .

i legend · 2 Gennaio 2020

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 · 3 Gennaio 2020

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

Sakti · 4 Gennaio 2020

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....

kira · 4 Gennaio 2020

allora è il mio anno,sono nata il gg.20 ? ? ? ? ? ?

i legend · 31 Maggio 2020

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

solare · 31 Maggio 2020

Ciao Ilegend, Grazie ottimo

lotto_tom75 · 31 Maggio 2020

Spettacolare mitico ilegend. L'ho chiamato tabellone-analitico-intelligente-by-ilegend.ls

GRAZIE! ???

i legend · 31 Maggio 2020

Grazie ragazzi

L importante è che funzioni correttamente. Controllate grazie

Sakti · 31 Maggio 2020

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

Xeroxs · 1 Giugno 2020

Grazie, I legend
Molto Utile e Ben Fatto.

un piccolo presente :)

Premium Member

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Premium Member

Premium Member

Advanced Member

Advanced Premium Member

Premium Member

Advanced Member >PLATINUM PLUS<

Premium Member

Premium Member

Advanced Member >GOLD<

Advanced Member >GOLD<

Advanced Premium Member

Premium Member

Advanced Member >PLATINUM<

Advanced Premium Member

Premium Member

Advanced Member >GOLD<

Advanced Member >PLATINUM<