variazione script di Ilegend

[ppaaoolloo]

ciao Ilegend

se possibile volevo proporre una variazione per questo script,
tenendo tutte le statistiche delle colonne intatte, ma modificando
solo la seconda colonna dei Num. Ric.

adeeso la ricerca viene fatta sui 90 numeri "analizzati singolarmente",
io invece vorrei poterlo usare sempre con i 90 numeri ma "in coppia".
ad esempio
1 e 2 come se fossero un numero
2 e 3 come se fossero un numero
3 e 4 come se fossero un numero
4 e 5 come se fossero un numero
5 e 6 come se fossero un numero
ecc. ecc. fino a 89 e 90 come se fossero un numero

spero di aver spiegato bene la variazione che chiedo
e che si possa fare, nel caso rispiegherò con altri
esempi ciò che richiedo, ecco qui sotto lo script
da cambiare

ringrazio anticipatamente per la disponibilità





Option Explicit
Sub Main
' Controllare Se lo script restituisce output corretti
'Se si dovessero riscontrare eventuali bugs comunicarli
'Lo script è di natura statistica non restituisce previsioni
' script per Paolo su Lottoced
Dim x,y,j,i,z,w 'variabili contatore
Dim rit1,ritmax1,IncRitmax1,Freq1
Dim rit2,ritmax2,IncRitmax2,Freq2
Dim rit3,ritmax3,IncRitmax3,Freq3
Dim rit4,ritmax4,IncRitmax4,Freq4
Dim rit5,ritmax5,IncRitmax5,Freq5
Dim ritT,ritmaxT,IncRitmaxT,FreqT,aPosT
Dim RMax,FMax,RRMax,rIncMax
Dim Inizio,qEstr,Ruota,Num,rp1
Dim aTitoli(25),aPos1(5),aPos2(5),aPos3(5),aPos4(5),aPos5(5),aPosTot(5)
ReDim aRuote(0),aNum(0)
If ImpostaParametri(qEstr,aNum,aRuote) = False Then
Call MsgBox("i Parametri inseriti sono errati",vbCritical)
Exit Sub
End If
Inizio = EstrazioneFin - qEstr
Call GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot)
Call GetTitoli(aTitoli)
Call InitTabella(aTitoli,RGB(192,192,192))
For x = 1 To UBound(aRuote)
Ruota = aRuote(x)
For y = 1 To UBound(aNum)
Num = aNum
Call Messaggio("Sto calcolando la ruota di : " & NomeRuota(Ruota))
Call AvanzamentoElab(1,90,Num)
If ScriptInterrotto Then Exit For
Call StatEstratto(Ruota,Num,rit1,ritmax1,IncRitmax1,Freq1,Inizio,,,,aPos1)
Call StatEstratto(Ruota,Num,rit2,ritmax2,IncRitmax2,Freq2,Inizio,,,,aPos2)
Call StatEstratto(Ruota,Num,rit3,ritmax3,IncRitmax3,Freq3,Inizio,,,,aPos3)
Call StatEstratto(Ruota,Num,rit4,ritmax4,IncRitmax4,Freq4,Inizio,,,,aPos4)
Call StatEstratto(Ruota,Num,rit5,ritmax5,IncRitmax5,Freq5,Inizio,,,,aPos5)
Call StatEstratto(Ruota,Num,ritT,ritmaxT,IncRitmaxT,FreqT,Inizio,,,,aPosT)
If Ruota <> 11 Then
rp1 = RitPosTurbo(Num,Ruota,EstrazioneFin)
Else
rp1 = "N.C."
End If
ReDim aRis(25)
Call alimentaArrayTabella(aRis,SiglaRuota(Ruota),Num,Freq1,Freq2,Freq3,Freq4,Freq5,FreqT,rit1,rit2,rit3,rit4,rit5,ritmax1,ritmax2,ritmax3,ritmax4,ritmax5,IncRitmax1,IncRitmax2,IncRitmax3,IncRitmax4,IncRitmax5,ritT,FMax,RMax,RRMax,rIncMax,rp1)
Call AddRigaTabella(aRis)
Call GetFormatCella(aRis,FMax,RMax,RRMax,rIncMax)
Next
Next
Call GetIntestazione(qEstr,Inizio,aNum,aRuote)
Call CreaTabellaOrdinabile
End Sub
Sub GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot)
Dim i
For i = 1 To 5
aPosTot(i) = True
Next
aPos1(1) = True
aPos2(2) = True
aPos3(3) = True
aPos4(4) = True
aPos5(5) = True
End Sub
Sub GetTitoli(aTitoli)
aTitoli(1) = "Ruota"
aTitoli(2) = "Num.Ric."
aTitoli(3) = "F. I"
aTitoli(4) = "F. II"
aTitoli(5) = "F.III"
aTitoli(6) = "F. IV"
aTitoli(7) = "F. V"
aTitoli(8) = "F.T"
aTitoli(9) = "R. I"
aTitoli(10) = "R. II"
aTitoli(11) = "R.III"
aTitoli(12) = "R. IV"
aTitoli(13) = "R. V"
aTitoli(14) = "R.Cr"
aTitoli(15) = "RMx. I"
aTitoli(16) = "RMx. II"
aTitoli(17) = "RMx.III"
aTitoli(18) = "RMx. IV"
aTitoli(19) = "RMx. V"
aTitoli(20) = "IRMx. I"
aTitoli(21) = "IRMx. II"
aTitoli(22) = "IRMx.III"
aTitoli(23) = "IRMx. IV"
aTitoli(24) = "IRMx. V"
aTitoli(25) = "RP1"
End Sub
Sub alimentaArrayTabella(aRis,ruote,Num,freq1,freq2,freq3,freq4,freq5,freqT,rit1,rit2,rit3,rit4,rit5,ritmax1,ritmax2,ritmax3,ritmax4,ritmax5,IncRitMax1,IncRitMax2,IncRitMax3,IncRitMax4,IncRitMax5,ritT,FMax,RMax,RRMax,rIncMax,rp1)
Dim aRit(5),aFreq(5),aRitMax(5),aIncRitMax(5)
Dim i,j,z,w
aRis(1) = ruote
aRis(2) = Num
aRis(3) = freq1
aRis(4) = freq2
aRis(5) = freq3
aRis(6) = freq4
aRis(7) = freq5
aRis(8) = freqT
aRis(9) = rit1
aRis(10) = rit2
aRis(11) = rit3
aRis(12) = rit4
aRis(13) = rit5
aRis(14) = ritT
aRis(15) = ritmax1
aRis(16) = ritmax2
aRis(17) = ritmax3
aRis(18) = ritmax4
aRis(19) = ritmax5
aRis(20) = IncRitMax1
aRis(21) = IncRitMax2
aRis(22) = IncRitMax3
aRis(23) = IncRitMax4
aRis(24) = IncRitMax5
aRis(25) = rp1
''''''''''''''''''''''''''''''''''''
' metto in array tutti i ritardi per posizione
For i = 1 To 5
aFreq(i) = aRis(i + 2)
Next
FMax = MassimoV(aFreq)
For j = 1 To 5
aRit(j) = aRis(j + 8)
Next
RMax = MassimoV(aRit)
For z = 1 To 5
aRitMax(z) = aRis(z + 14)
Next
RRMax = MassimoV(aRitMax)
For w = 1 To 5
aIncRitMax(w) = aRis(w + 19)
Next
rIncMax = MassimoV(aIncRitMax)
End Sub
Sub GetFormatCella(aRis,Fmax,Rmax,RRMax,rIncMax)
Dim i,j,z,w
Call SetColoreCella(2,RGB(254,241,199))
For i = 3 To 7
If aRis(i) = Fmax Then Call SetColoreCella(CInt(i),RGB(255,217,236))
Next
For j = 9 To 13
If aRis(j) = aRis(14) Then Call SetColoreCella(CInt(j),RGB(230,255,234))
If aRis(j) = Rmax Then Call SetColoreCella(CInt(j),vbRed)
Next
For z = 15 To 19
If aRis(z) = RRMax Then Call SetColoreCella(CInt(z),RGB(166,210,225))
Next
For w = 20 To 24
If rIncMax <> 0 Then
If aRis(w) = rIncMax Then Call SetColoreCella(CInt(w),vbGreen)
End If
Next
Call SetColoreCella(8,RGB(221,219,170))
Call SetColoreCella(14,RGB(221,219,170))
End Sub
Sub GetIntestazione(qEstr,Inizio,aNum,aRuote)
Scrivi "Disclaimer",True
Scrivi "Il Gioco è vietato ai minori di anni 18,e, può comportare grave dipendenza patologica ",True,vbRed
Scrivi ""
Scrivi "Analisi di un Numero su Ruota a scelta "
Scrivi ""
Scrivi "Inizio analisi Estrazioni : " & GetInfoEstrazione(Inizio)
Scrivi "Estrazioni Analizzate : " & qEstr
Scrivi "Numeri analizzati : " & StringaNumeri(aNum,,True)
Scrivi "Ruote analizzate : " & StringaRuote(aRuote)
Scrivi
End Sub
Function ImpostaParametri(qEstr,aNum,aRuote)
Dim bRet
qEstr = CInt(InputBox("Analisi n Estrazioni","Estrazioni a Ritroso",EstrazioneFin))
If qEstr >= 0 And qEstr <= EstrazioneFin Then
ScegliNumeri(aNum)
If UBound(aNum) > 0 Then
ScegliRuote(aRuote)
If UBound(aRuote) > 0 Then
bRet = True
End If
End If
End If
ImpostaParametri = bRet
End Function

 

[i legend]

Ciao Paolo, ho fatto la modifica ti posto lo script domani . Ciao .

 

[ppaaoolloo]

ciao Ilegend
grazie mille per averlo fatto così velocemente
aspetto con ansia la tua modifica

buona serata

 

[i legend]

ciao paolo per favore pazienta un po che sto facendo delle verifiche.

 

[i legend]

Ciao Paolo, ho fatto lo script richiesto, ma per favore controlla che funzioni correttamente.

Option Explicit
' script per Paolo utente su forum LottoCed
' lo script non restituisce previsioni, controllare  da altre fonti se i dati in output siano esatti
' gli errori sono sempre possibili
' lo script è dato gratuitamente nessuno puo venderlo o cederlo chiedendo una donazione in cambio
Sub Main
   ' dichiaro le variabili di impostazione ricerca  da utilizzare
   Dim Ini,Fin,bRet,aComb,nClasse
   ReDim aRu(0)
   'Verifico che i parametri inseriti siano corretti
   aComb = Array("Estratto","Coppia")
   bRet = False
   If MsgBox("Non si garantisce la correttezza dei dati Riportati " & vbCrLf & "Vuoi continuare ugualmente ?",_
      32 + 4,"Script Statistico per estratto o coppia nelle 5 posizioni") = vbYes Then
      If ScegliRange(Ini,Fin,EstrazioneIni,EstrazioneFin) Then
         Call ScegliRuote(aRu)
         If UBound(aRu) Then
            nClasse = ScegliOpzioneMenu(aComb,0,"Classe da Sviluppare") + 1
            If nClasse Then
               bRet = True
            Else
               Call MsgBox("Non hai inserito alcuna Classe",vbYes,"Wrong Message")
            End If
         Else
            Call MsgBox("Non hai inserito alcuna ruota",vbYes,"Wrong Message")
         End If
      Else
         Call MsgBox("Il range Estrazioni inserito non è valido",vbYes,"Wrong Message")
      End If
   Else
      Exit Sub
   End If
   If bRet = False Then Exit Sub
   ' dichiaro le altre variabili utili alla ricerca
   ReDim aNum(90)
   Dim N,p,C,Rit,RitMax,Freq,SumRit,SumFreq,idSvi
   Dim RcMax,RstoMin,RstoMax,FreqMax,FreqMin,RcMin
   Dim aRit(5),aRitMax(5),aFreq(5),aPos(1)
   For N = 1 To 90
      aNum(N) = N
   Next
   Dim colT:colT = InitSviluppoIntegrale(aNum,nClasse)
   Dim aTit:aTit = Array(0,"IdComb","Formazione","FrP1","FrP2","FrP3","FrP4","FrP5","SumFre","FreqMin","FreqMax","RcP1","RcP2","RcP3","RcP4","RcP5","SumRit","RitMin","RitMax","RsP1","RsP2","RsP3","RsP4","RsP5","RstMin","RstMax")
   Call InitTabella(aTit)
   idSvi = 0
   Do While GetCombSviluppo(aNum)
      If ScriptInterrotto Then Exit Do
      idSvi = idSvi + 1
      Call AvanzamentoElab(1,colT,idSvi)
      SumRit = 0
      SumFreq = 0
      For p = 1 To 5
         aPos(1) = p
         Call StatisticaFormazioneTurbo(aNum,aRu,1,Rit,RitMax,0,Freq,Ini,Fin,,aPos)
         aRit(p) = Rit
         aRitMax(p) = RitMax
         aFreq(p) = Freq
         SumRit = SumRit + Rit
         SumFreq = SumFreq + Freq
      Next
      RcMin = MinimoV(aRit,1,5)
      RcMax = MassimoV(aRit)
      FreqMin = MinimoV(aFreq,1,5)
      RstoMax = MassimoV(aRitMax)
      RstoMin = MinimoV(aRitMax,1,5)
      FreqMax = MassimoV(aFreq)
      Dim atab
      atab = Array(0,idSvi,StringaNumeri(aNum,,True),aFreq(1),aFreq(2),aFreq(3),aFreq(4),aFreq(5),SumFreq,FreqMin,FreqMax,_
      aRit(1),aRit(2),aRit(3),aRit(4),aRit(5),SumRit,RcMin,RcMax,aRitMax(1),aRitMax(2),aRitMax(3),aRitMax(4),aRitMax(5),RstoMin,RstoMax)
      Call AddRigaTabella(atab,RGB(240,240,255))
      ' imposto la formattazione delle celle
      Call SetColoreCella(1,RGB(240,240,240),RGB(128,0,0))
      Call SetColoreCella(2,RGB(255,255,255),RGB(20,68,107))
      For C = 3 To 7
         If atab(C) = atab(9) Then
            Call SetColoreCella(Int(C),RGB(255,213,213),RGB(83,0,0))
         ElseIf atab(C) = atab(10) Then
            Call SetColoreCella(Int(C),RGB(218,250,247),RGB(11,79,72))
         End If
      Next
      Call SetColoreCella(8,vbWhite,RGB(0,100,0))
      Call SetColoreCella(9,vbWhite,RGB(255,0,0))
      Call SetColoreCella(10,vbWhite,RGB(0,73,147))
      For C = 11 To 15
         If atab(C) = atab(17) Then
            Call SetColoreCella(Int(C),RGB(255,213,213),RGB(83,0,0))
         ElseIf atab(C) = atab(18) Then
            Call SetColoreCella(Int(C),RGB(218,250,247),RGB(11,79,72))
         End If
      Next
      Call SetColoreCella(16,vbWhite,RGB(0,100,0))
      Call SetColoreCella(17,vbWhite,RGB(255,0,0))
      Call SetColoreCella(18,vbWhite,RGB(0,73,147))
      For C = 19 To 23
         If atab(C) = atab(24) Then
            Call SetColoreCella(Int(C),RGB(255,213,213),RGB(83,0,0))
         ElseIf atab(C) = atab(25) Then
            Call SetColoreCella(Int(C),RGB(218,250,247),RGB(11,79,72))
         End If
      Next
      Call SetColoreCella(24,vbWhite,RGB(255,0,0))
      Call SetColoreCella(25,vbWhite,RGB(0,73,147))
   Loop
   If ScriptInterrotto Then
      Scrivi "Lo script è stato interrotto"
      Exit Sub
   End If
   ' scrivo i parametri di ricerca
   Dim sRic
   If nClasse = 1 Then sRic = "un Estratto":Else sRic = "una Coppia per estratto"
   Scrivi FormatSpace("  Analisi Ritardi e Frequenze di " & sRic & "  nelle cinque posizioni",158),1,,RGB(240,240,240),RGB(100,100,100)
   Scrivi FormatSpace(" ",158),,,RGB(238,238,239),vbWhite
   Scrivi FormatSpace("  Data inizio Analisi:     " & DataEstrazione(Ini) & "    ( Conc: " & FormatSpace(Ini,5,1) & " )",158),1,,RGB(245,245,247),RGB(100,100,100)
   Scrivi FormatSpace("  Data fine Analisi:       " & DataEstrazione(Fin) & "    ( Conc: " & FormatSpace(Fin,5,1) & " )",158),1,,RGB(246,246,248),RGB(100,100,100)
   Scrivi FormatSpace("  Ruote analizzate:        " & StringaRuote(aRu),158),1,,RGB(247,247,249),RGB(100,100,100)
   Scrivi FormatSpace(" ",158),,,RGB(248,248,250)
   Scrivi
   Scrivi FormatSpace("  Legenda Colori utilizzati  ",158),1,,RGB(0,128,192),RGB(240,250,255)
   Scrivi
   Scrivi "    FreqMin,RitMin,RstoMin   ",1,,RGB(255,213,213),RGB(83,0,0)
   Scrivi
   Scrivi "    FreqMax,RitMax,RstoMax   ",1,,RGB(218,250,247)
      Scrivi
   Call SetTableWidth("1270 pxz")
   Call SetTableHeight("286 pxz")
   Call CreaTabellaOrdinabile()
End Sub

ciao a tutti.

 

[ppaaoolloo]

ciao Ilegend
grazie quello che hai fatto, è un grande lavoro
lo sto provando.
quello che chiedevo io però era una cosa più ristretta,
tu hai messo il numero 1 con gli altri 89 numeri
il numero 2 con gli altri 89 numeri
il numero 3 con gli altri 89 numeri
il numero 4 con gli altri 89 numeri
ecc. ecc.

mentre a me basta solo due numeri consecutivi
il numero 1 solo con il 2
il numero 2 solo con il 3
il numero 3 solo con il 4
il numero 4 solo con il 5
il numero 5 solo con il 6
ecc.ecc.
alla fine IdComb devono essere 90

ti ringrazio ancora per quello che hai fatto
e ti chiedo se puoi correggerlo come da me richiesto,
così com'è IdComb sono più di 4000 e i tempi di elaborazione
con il mio pc sono piuttosto lunghi

ti ringrazio ancora per la tua disponibilità e spero che tu abbia
ancora tempo e voglia per poterlo modificare

grazie

salutoni

 

[i legend]

Ciao la modifica l ho fatta ma mi è venuta un idea per migliorare la routine , appena ho un ' po' di tempo per metterla giù la invio.

 

[ppaaoolloo]

ciao Ilegend
ti ringrazio per la tua disponibilità e cortesia

a presto

ciao

 

[i legend]

Ciao perfavore provalo e dimmi se queste sono le modifiche che ti occorrevano .

Option Explicit

Sub Main
   Call MsgBox("controllare che i dati in output siano esatti, non se ne garantisce l ' esattezza." & vbCrLf & _
   "controllare se ci sono eventuali bugs, e segnalarli" & vbCrLf & _
   "lo script è dato cosi com ' è, in modalita gratuita, nessuno puo venderlo o cederlo in cambio di una donazione" & vbCrLf & _
   "il gioco è vietato ai minori di anni 18 e può provocare grave dipendenza patologica" & vbCrLf & _
   "lo script è una richiesta dell utente ppaaoolloo di lottoCed" & vbCrLf & _
   "Le modifiche allo script possono comprometterne il funzionamento",vbInformation,"informazioni generali script")
   If MsgBox("Non si garantisce la correttezza dei dati Riportati " & vbCrLf & "Vuoi continuare ugualmente ?",_
      32 + 4,"Script Statistico Estratti nelle 5 posizioni") = vbYes Then
      Dim aSviluppo:aSviluppo = Array("Integrale","Ridotto Consecutivi")
      Dim aClasse
      Dim aSviRuote:aSviRuote = Array("Ruote Unite","Ruote Separate")
      Dim Ini,Fin,bRet,aComb,nClasse,idComb,N,IdSvi,sRic,sRu,idRicRu,IdForm,ColT,idCls
      bRet = False
      If ScegliRange(Ini,Fin,EstrazioneIni,EstrazioneFin) Then
         ReDim aRuote(0) :Call ScegliRuote(aRuote)
         If UBound(aRuote) Then
            If UBound(aRuote) = 1 Then
               idRicRu = 1
            Else
               idRicRu = ScegliOpzioneMenu(aSviRuote,0,"Scegli Sviluppo ruote") + 1
            End If
            If idRicRu Then
               IdSvi = ScegliOpzioneMenu(aSviluppo,0,"Scegli Sviluppo Combinazioni") + 1
               If IdSvi Then
                  If IdSvi = 1 Then
                     idCls = 1
                     aClasse = Array("Estratti","Coppie")
                     nClasse = ScegliOpzioneMenu(aClasse,0,"Scegli Classe Combinazioni") + idCls
                  ElseIf IdSvi = 2 Then
                     idCls = 2
                     aClasse = Array("Coppie","Terne","Quaterne","Cinquine","Sestine","Settine","Ottine","Novine","Decine")
                     nClasse = ScegliOpzioneMenu(aClasse,0,"Scegli Classe Combinazioni") + idCls
                  End If
                  If nClasse Then
                     bRet = True
                  Else
                     Call MsgBox("Non hai inserito alcuna classe",vbYes,"Wrong Message")
                  End If
               Else
                  Call MsgBox("Non hai selezionato correttamente la" & vbCrLf & "modalita di sviluppo combinazione",vbYes,"Wrong Message")
               End If
            Else
               Call MsgBox("Non hai inserito il collegamento Ruote ",vbYes,"Wrong Message")
            End If
         ElseIf UBound(aRuote) <= 0 Then
            Call MsgBox("Non hai inserito alcuna ruota",vbYes,"Wrong Message")
         End If
      Else
         Call MsgBox("Il range Estrazioni inserito non è valido",vbYes,"Wrong Message")
      End If
   Else
      Exit Sub
   End If
   If bRet = False Then Exit Sub
   If IdSvi = 1 And idRicRu = 2 Then nClasse = 1 :Call MsgBox("Su ruote separate è consentita solo la classe di sviluppo Estratto",vbInformation,"Info sviluppo combinazioni")
   Call ResetTimer()
   Dim aTit:aTit = Array(0,"IdComb","Ruote","Formazione","FrP1","FrP2","FrP3","FrP4","FrP5","SumFre","FreqMin","FreqMax","RcP1","RcP2","RcP3","RcP4","RcP5","SumRit","RitMin","RitMax","RsP1","RsP2","RsP3","RsP4","RsP5","RstMin","RstMax")
   Call InitTabella(aTit)
   ReDim aNum(90)
   For N = 1 To 90
      aNum(N) = N
   Next
   ColT = InitSviluppoIntegrale(aNum,nClasse)
   IdForm = 0
   Select Case IdSvi
   Case 1
      If idRicRu = 1 Then
         Do While GetCombSviluppo(aNum)
            IdForm = IdForm + 1
            If ScriptInterrotto Then Exit Do
            Call AvanzamentoElab(1,ColT,IdForm)
            Call GetStat(IdForm,Ini,Fin,aRuote,aNum)
         Loop
      Else
         Do While GetCombSviluppo(aNum)
            If ScriptInterrotto Then Exit Do
            Call AvanzamentoElab(1,ColT,IdForm)
            IdForm = IdForm + 1
            Call GetStatSep(IdForm,Ini,Fin,aRuote,aNum)
         Loop
      End If
   Case 2
      If idRicRu = 1 Then
         Do While GetCombSviluppoRid(aNum,1)
            If ScriptInterrotto Then Exit Do
            IdForm = IdForm + 1
            Call AvanzamentoElab(1,90 -(nClasse - idCls),IdForm)
            Call GetStat(IdForm,Ini,Fin,aRuote,aNum)
         Loop
      Else
         Do While GetCombSviluppoRid(aNum,1)
            If ScriptInterrotto Then Exit Do
            IdForm = IdForm + 1
            Call AvanzamentoElab(1,90 -(nClasse - idCls),IdForm)
            Call GetStatSep(IdForm,Ini,Fin,aRuote,aNum)
         Loop
      End If
   End Select
   ' scrivo i parametri di ricerca
   Scrivi FormatSpace("  Analisi Ritardi e Frequenze di una formazione  nelle cinque posizioni",194),1,,RGB(240,240,240),RGB(100,100,100)
   Scrivi FormatSpace(" ",194),,,RGB(238,238,239),vbWhite
   Scrivi FormatSpace("  Data inizio Analisi:            " & DataEstrazione(Ini) & "    ( Conc: " & FormatSpace(Ini,5,1) & " )",194),1,,RGB(245,245,247),RGB(100,100,100)
   Scrivi FormatSpace("  Data fine Analisi:              " & DataEstrazione(Fin) & "    ( Conc: " & FormatSpace(Fin,5,1) & " )",194),1,,RGB(246,246,248),RGB(100,100,100)
   Scrivi FormatSpace("  Analisi Ruote:                  " & aSviRuote(idRicRu - 1),194),1,,RGB(246,246,248),RGB(100,100,100)
   Scrivi FormatSpace("  Sistema Sviluppo:               " & aSviluppo(IdSvi - 1),194),1,,RGB(246,246,248),RGB(100,100,100)
   Scrivi FormatSpace("  Formazione:                     " & aClasse(nClasse - idCls),194),1,,RGB(246,246,248),RGB(100,100,100)
   Scrivi FormatSpace(" ",194),,,RGB(248,248,250)
   Scrivi
   Scrivi FormatSpace("  Legenda Colori utilizzati  ",194),1,,RGB(0,128,192),RGB(240,250,255)
   Scrivi
   Scrivi "    FreqMin,RitMin,RstoMin   ",1,,RGB(255,128,128),RGB(83,0,0)
   Scrivi
   Scrivi "    FreqMax,RitMax,RstoMax   ",1,,RGB(118,235,156)
   Scrivi
   Call SetTableWidth("100%")
   Call SetTableHeight("286 pxz")
   Scrivi "Elaborato in : " & TempoTrascorso()
   Call CreaTabellaOrdinabile()
End Sub
Sub GetStat(idSvi,Ini,Fin,aRu,aNum)
   Dim p,C,Rit,RitMax,Freq,SumRit,SumFreq,aTab
   Dim RcMax,RstoMin,RstoMax,FreqMax,FreqMin,RcMin
   Dim aRit(5),aRitMax(5),aFreq(5),aPos(1)
   SumRit = 0
   SumFreq = 0
   For p = 1 To 5
      aPos(1) = p
      Call StatisticaFormazioneTurbo(aNum,aRu,1,Rit,RitMax,0,Freq,Ini,Fin,,aPos)
      aRit(p) = Rit
      aRitMax(p) = RitMax
      aFreq(p) = Freq
      SumRit = SumRit + Rit
      SumFreq = SumFreq + Freq
   Next
   RcMin = MinimoV(aRit,1,5)
   RcMax = MassimoV(aRit)
   FreqMin = MinimoV(aFreq,1,5)
   RstoMax = MassimoV(aRitMax)
   RstoMin = MinimoV(aRitMax,1,5)
   FreqMax = MassimoV(aFreq)
   aTab = Array(0,idSvi,StringaRuote(aRu),StringaNumeri(aNum,,True),aFreq(1),aFreq(2),aFreq(3),aFreq(4),aFreq(5),SumFreq,FreqMin,FreqMax,_
   aRit(1),aRit(2),aRit(3),aRit(4),aRit(5),SumRit,RcMin,RcMax,aRitMax(1),aRitMax(2),aRitMax(3),aRitMax(4),aRitMax(5),RstoMin,RstoMax)
   Call AddRigaTabella(aTab,RGB(234,234,255))
   Call ColoraCella(aTab)
End Sub
Sub GetStatSep(idSvi,Ini,Fin,aRu,aNum)
   Dim p,C,R,Rit,RitMax,Freq,SumRit,SumFreq,aTab
   Dim RcMax,RstoMin,RstoMax,FreqMax,FreqMin,RcMin
   Dim aRit(5),aRitMax(5),aFreq(5),aPos(1),aRsing(1)
   For R = 1 To UBound(aRu)
      aRsing(1) = aRu(R)
      SumRit = 0
      SumFreq = 0
      For p = 1 To 5
         aPos(1) = p
         Call StatisticaFormazioneTurbo(aNum,aRsing,1,Rit,RitMax,0,Freq,Ini,Fin,,aPos)
         aRit(p) = Rit
         aRitMax(p) = RitMax
         aFreq(p) = Freq
         SumRit = SumRit + Rit
         SumFreq = SumFreq + Freq
      Next
      RcMin = MinimoV(aRit,1,5)
      RcMax = MassimoV(aRit)
      FreqMin = MinimoV(aFreq,1,5)
      RstoMax = MassimoV(aRitMax)
      RstoMin = MinimoV(aRitMax,1,5)
      FreqMax = MassimoV(aFreq)
      aTab = Array(0,idSvi,NomeRuota(aRsing(1)),StringaNumeri(aNum,,True),aFreq(1),aFreq(2),aFreq(3),aFreq(4),aFreq(5),SumFreq,FreqMin,FreqMax,_
      aRit(1),aRit(2),aRit(3),aRit(4),aRit(5),SumRit,RcMin,RcMax,aRitMax(1),aRitMax(2),aRitMax(3),aRitMax(4),aRitMax(5),RstoMin,RstoMax)
      Call AddRigaTabella(aTab,RGB(234,234,255))
      Call ColoraCella(aTab)
   Next
End Sub
Sub ColoraCella(aTab)
   Dim c
   Call SetColoreCella(1,RGB(240,240,240),RGB(128,0,0))
   Call SetColoreCella(2,RGB(215,255,255),RGB(20,68,107))
   Call SetColoreCella(3,RGB(215,255,255),RGB(20,68,107))
   For c = 4 To 8
      If aTab(c) = aTab(10) Then
         Call SetColoreCella(Int(c),RGB(255,128,128),RGB(83,0,0))
      ElseIf aTab(c) = aTab(11) Then
         Call SetColoreCella(Int(c),RGB(118,235,156),RGB(11,79,72))
      End If
   Next
   Call SetColoreCella(9,vbWhite,RGB(0,100,0))
   Call SetColoreCella(10,vbWhite,RGB(255,0,0))
   Call SetColoreCella(11,vbWhite,RGB(0,73,147))
   For c = 12 To 16
      If aTab(c) = aTab(18) Then
         Call SetColoreCella(Int(c),RGB(255,128,128),RGB(83,0,0))
      ElseIf aTab(c) = aTab(19) Then
         Call SetColoreCella(Int(c),RGB(118,235,156),RGB(11,79,72))
      End If
   Next
   Call SetColoreCella(17,vbWhite,RGB(0,100,0))
   Call SetColoreCella(18,vbWhite,RGB(255,0,0))
   Call SetColoreCella(19,vbWhite,RGB(0,73,147))
   For c = 20 To 24
      If aTab(c) = aTab(25) Then
         Call SetColoreCella(Int(c),RGB(255,128,128),RGB(83,0,0))
      ElseIf aTab(c) = aTab(26) Then
         Call SetColoreCella(Int(c),RGB(118,235,156),RGB(11,79,72))
      End If
   Next
   Call SetColoreCella(25,vbWhite,RGB(255,0,0))
   Call SetColoreCella(26,vbWhite,RGB(0,73,147))
End Sub

ho cercato di ridurre il piu possibile il numero delle righe e scrivere un codice il piu possibile corretto e semplice per chi vuole cominciare a studiare e buttare giu qualche script.
ciao

 

[zagort]

legend ...a sto livello non è buttare giu qualche script ....ma saper ptogrammare....complimenti

 

[i legend]

Grazie zagort , troppo gentile, ma davvero lo script è molto semplice, e inoltre non eser itandomi mi sono un Po arrugginito.
per favore chi ha modo di controllare e confrontare i dati con altre fonti segnali se ci sono errori.
ciao a tutti

 

[ppaaoolloo]

ciao Ilegend
innanzi tutto grazie per quello che hai fatto,
come ha detto zagortè davvero qualcosa di super
tra oggi e domani (lavoro permettendo) farò tutte le provepossibili

unica cosa che adesso ti chiedo è se è possibile
poter visualizzare i risultati in modo completo,
infatti ne vedo a schermo circa una decina
poi devo usare la barra laterale di scorrimento
se possibile vedere di più.

ancora grazie e ti auguro un buon fine settimana

ciao

 

[i legend]

Ciao ppaaoolloo
basta mettere un apice davanti

' Call SetTableHeight("286 pxz")

 

[i legend]

Buon fine settimana anche a te

 

[ppaaoolloo]

ciao Ilegend
innanzi tutto voglio farti i complimenti per lo script che hai fatto,
davvero grazie tanto
ho provato e riprovato tutto ed i dati che ho potuto controllare sono esatti.

l'unica cosa se ne avrai il tempo e la voglia è la variazione di posizione
di alcune colonne e l'aggunta di altre,
le prime 3 colonne le lascerei invariate
nella quarta metterei il ritartdo minimo
nella quinta il ritardo massimo
nella sesta RcP1
nella settima RcP2
nell'ottava RcP3
nella nona RcP4
nella decima RcP5
nella undicesima RcP1+RcP2 (adesso non c'è)
nella dodicesima RcP1+RcP2+RcP3 (adesso non c'è)
nella tredicesima RcP1+RcP2+RcP3+RcP4 (adesso non c'è)
nella quattordicesima RcP1+RcP2+RcP3+RcP4+RcP5 (adesso non c'è)
poi a seguire
RsP1
RsP2
RsP3
RsP4
RsP5
Rst Min
Rst Max
FrP1
FrP2
FrP3
FrP4
FrP5
Sum Fre
FreMin
FreMax

ti ringrazio anticipatamente della tua disponibilità
se vorrai ancora metterci mano

buona serata e buona settimana

ciao