aggiunta di alcune colonne allo script di mike

ppaaoolloo · 16 Novembre 2020

ciao
vorrei aggiungere 6 colonne a questo script fatto dal grande Mike
dove io ho leggermente aumentato le colonne,
si tratterebbe di aggiungerne altre 5 che mi diano il ritardo cronologico per
ogni colonna colonna dell'estrazione
cioè:
il ritardo cronologico della 1 colonna chiamandolo aPos(1)
il ritardo cronologico della 2 colonna chiamandolo aPos(2)
il ritardo cronologico della 3 colonna chiamandolo aPos(3)
il ritardo cronologico della 4 colonna chiamandolo aPos(4)
il ritardo cronologico della 5 colonna chiamandolo aPos(5)
e come sesta colonna la somma dei ritardi delle 5 colonne chiamandolo Sum Rit

andrebbero inserite dopo l'attuale quarta colonna cioè Rit. M.

Uno script simile era stato fatto da Ilegend, ma questo di Mike mi verrebbe
più facile da usare per le mie esigenze perchè potrei variare a mia scelta
i vari numeri per la ricerca

ringrazio anticipatamente e saluto tutti calorosamente

Sub Main
Dim a(90)
Dim Ru(1)
ReDim aRuote(11)
qualeTab = CInt(InputBox("QUALE TABELLA","1 = Tab Normale 2 = Tab excel",2))
'rt = CInt(InputBox("Quale ruota analizzare ","Ruota",11))
qt = CInt(InputBox("QUANTE ESTRAZIONI CONTROLLO",,200))
sorte = CInt(InputBox("QUALE SORTE ",,1))
color = CInt(InputBox("Quale DECINA vuoi evidenziare",,1))
Dim posta(2)
posta(1) = 1
posta(2) = 1
Fin = EstrazioneFin
Ini = EstrazioneFin - qt
If ScegliRuote(aRuote) > 0 Then
Scrivi "Ruota Di : " & StringaRuote(aRuote),1,0,2,4,3
Scrivi " dal " & DataEstrazione(Ini) & " al " & DataEstrazione(Fin),1
Scrivi "Sorte analizzata..." & NomeSorte(sorte),1,1,,1,3
Scrivi
For k = 1 To UBound(aRuote)
If aRuote(k) > 0 Then
Ru(1) = aRuote(k)
'For rt = 1 To 12
'Ru(1) = aRuote(k)
ReDim atitoli(30)
atitoli(01) = " fila "
atitoli(02) = " numeri "
atitoli(03) = " Rit. "
atitoli(04) = " Rit. M. "
atitoli(05) = " Estr. "
atitoli(06) = " -1 "
atitoli(07) = " -2 "
atitoli(08) = " -3 "
atitoli(09) = " -4 "
atitoli(10) = " -5 "
atitoli(11) = " -6 "
atitoli(12) = " -7 "
atitoli(13) = " -8 "
atitoli(14) = " -9 "
atitoli(15) = " -10 "
atitoli(16) = " Estr. "
atitoli(17) = " +2 "
atitoli(18) = " +3 "
atitoli(19) = " +4 "
atitoli(20) = " +5 "
atitoli(21) = " +6 "
atitoli(22) = " +7 "
atitoli(23) = " +8 "
atitoli(24) = " +9 "
atitoli(25) = " +10 "
atitoli(26) = " +11 "
atitoli(27) = " I.C. "
atitoli(28) = " Media uscita "
atitoli(29) = " Stringa estratti "
atitoli(30) = " Ultima ESTR_Esito "

Call InitTabella(atitoli,2,,2,5)

a(01) = "01-02"
a(02) = "03-04"
a(03) = "05-06"
a(04) = "07-08"
a(05) = "09-10"
a(06) = "11-12"
a(07) = "13-14"
a(08) = "15-16"
a(09) = "17-18"
a(10) = "19-20"
a(11) = "21-22"
a(12) = "23-24"
a(13) = "25-26"
a(14) = "27-28"
a(15) = "29-30"
a(16) = "31-32"
a(17) = "33-34"
a(18) = "35-36"
a(19) = "37-38"
a(20) = "39-40"
a(21) = "41-42"
a(22) = "43-44"
a(23) = "45-46"
a(24) = "47-48"
a(25) = "49-50"
a(26) = "51-52"
a(27) = "53-54"
a(28) = "55-56"
a(29) = "57-58"
a(30) = "59-60"
a(31) = "61-62"
a(32) = "63-64"
a(33) = "65-66"
a(34) = "67-68"
a(35) = "69-70"
a(36) = "71-72"
a(37) = "73-74"
a(38) = "75-76"
a(39) = "77-78"
a(40) = "79-80"
a(41) = "81-82"
a(42) = "83-84"
a(43) = "85-86"
a(44) = "87-88"
a(45) = "89-90"
'--------------------------------------------------------------------
ReDim aPos(5)
aPos(1) = True
aPos(2) = True
aPos(3) = True
'aPos(4) = True
'aPos(5) = True
For N = 1 To UBound(a)
Nu = Split("0-" &(a

),"-")
Call StatisticaFormazioneTurbo(nu,aRuote,sorte,rit,max,Incr,fre,Ini,fin,,aPos)
'If Ru(1) = 11 Then
'ReDim rr(10)
'For xx = 1 To 10
'rr(xx) = xx
'Call VerificaEsito(nu,rr,fin - rit,sorte,,Nothing,retesito,,retestratti)
'Call VerificaEsito(nu,rr,EstrazioneFin,3,,,esitoF,,estr F)
'aaa = SerieFreq(EstrazioneFin,EstrazioneFin,nu,rr,1)
'Next
'End If
'If Ru(1) <> 11 Then
Call VerificaEsito(nu,aRuote,fin - rit,sorte,,Nothing,retesito,,retestratti)
Call VerificaEsito(nu,aRuote,EstrazioneFin,1,,Nothing,esitoF,,estrF)
'aaa = SerieFreq(EstrazioneFin,EstrazioneFin,nu,aRuote,1)
Call StatisticaFormazioneTurbo(nu,aRuote,1,ritP,maxP,IncrP,aaa,fin,fin,,aPos)
bbb = SerieFreq(EstrazioneFin - 1,EstrazioneFin - 1,nu,aRuote,1)
ccc = SerieFreq(EstrazioneFin - 2,EstrazioneFin - 2,nu,aRuote,1)
ddd = SerieFreq(EstrazioneFin - 3,EstrazioneFin - 3,nu,aRuote,1)
eee = SerieFreq(EstrazioneFin - 4,EstrazioneFin - 4,nu,aRuote,1)
fff = SerieFreq(EstrazioneFin - 5,EstrazioneFin - 5,nu,aRuote,1)
ggg = SerieFreq(EstrazioneFin - 6,EstrazioneFin - 6,nu,aRuote,1)
hhh = SerieFreq(EstrazioneFin - 7,EstrazioneFin - 7,nu,aRuote,1)
iii = SerieFreq(EstrazioneFin - 8,EstrazioneFin - 8,nu,aRuote,1)
lll = SerieFreq(EstrazioneFin - 9,EstrazioneFin - 9,nu,aRuote,1)
mmm = SerieFreq(EstrazioneFin - 10,EstrazioneFin - 10,nu,aRuote,1)

'End If
If fre > 0 Then
ReDim avalori(30)
avalori(01) = " Dec. " & Format2

avalori(02) = StringaNumeri(nu)
avalori(03) = rit
avalori(04) = max
avalori(05) = aaa
avalori(06) = bbb
avalori(07) = ccc
avalori(08) = ddd
avalori(09) = eee
avalori(10) = fff
avalori(11) = ggg
avalori(12) = hhh
avalori(13) = iii
avalori(14) = lll
avalori(15) = mmm
avalori(16) = aaa
avalori(17) = aaa + bbb
avalori(18) = aaa + bbb + ccc
avalori(19) = aaa + bbb + ccc + ddd
avalori(20) = aaa + bbb + ccc + ddd + eee
avalori(21) = aaa + bbb + ccc + ddd + eee + fff
avalori(22) = aaa + bbb + ccc + ddd + eee + fff + ggg
avalori(23) = aaa + bbb + ccc + ddd + eee + fff + ggg + hhh
avalori(24) = aaa + bbb + ccc + ddd + eee + fff + ggg + hhh + iii
avalori(25) = aaa + bbb + ccc + ddd + eee + fff + ggg + hhh + iii + lll
avalori(26) = aaa + bbb + ccc + ddd + eee + fff + ggg + hhh + iii + lll + mmm
avalori(27) = Round(qt/fre,2)
avalori(28) = Round(fre/qt*rit,2)
avalori(29) = retestratti
avalori(30) = esitoF & " : " & estrF

Call AddRigaTabella(avalori,,,2)
End If
For x = 1 To 12
If n = color Then Call SetColoreCella((x),3,1)
Next
Next
End If
Next
End If
Call SetTableWidth("100%")
If qualeTab = 1 Then Call CreaTabella(6)
If qualeTab = 2 Then Call CreaTabellaOrdinabile(6)
If qualeTab > 2 Then MsgBox " errore digit Tabella"
PicClear
Call PicStampaTesto(1,10,"Script by Mike58 ",,1,1,,11,vbRed)
PicEsegui
End Sub

Mike58 · 16 Novembre 2020

Ciao Paolo, premesso che non mi piace più rielaborare vecchi script in quanto oltre a non essere + stimolante c'è anche un dispendio di energie a comprendere dove intervenire.

Comunque eccoti la parte richiesta.

Codice:

Sub Main
   Dim a(90)
   Dim Ru(1)
   ReDim aRuote(11)
   qualeTab = CInt(InputBox("QUALE TABELLA","1 = Tab Normale 2 = Tab excel",1))
   'rt = CInt(InputBox("Quale ruota analizzare ","Ruota",11))
   qt = CInt(InputBox("QUANTE ESTRAZIONI CONTROLLO",,200))
   sorte = CInt(InputBox("QUALE SORTE ",,1))
   color = CInt(InputBox("Quale DECINA vuoi evidenziare",,1))
   Dim posta(2)
   posta(1) = 1
   posta(2) = 1
   Fin = EstrazioneFin
   Ini = EstrazioneFin - qt
   If ScegliRuote(aRuote) > 0 Then
      Scrivi "Ruota Di : " & StringaRuote(aRuote),1,0,2,4,3
      Scrivi " dal " & DataEstrazione(Ini) & " al " & DataEstrazione(Fin),1
      Scrivi "Sorte analizzata..." & NomeSorte(sorte),1,1,,1,3
      Scrivi
      For k = 1 To UBound(aRuote)
         If aRuote(k) > 0 Then
            Ru(1) = aRuote(k)
            'For rt = 1 To 12
            'Ru(1) = aRuote(k)
            ReDim atitoli(36)
            atitoli(01) = " fila "
            atitoli(02) = " numeri "
            atitoli(03) = " Rit. "
            atitoli(04) = " Rit. M. "
            atitoli(5) = "Rd1"
            atitoli(6) = "Rd2"
            atitoli(7) = "Rd3"
            atitoli(8) = "Rd4"
            atitoli(9) = "Rd5"
            atitoli(10) = "Sum Rd"
            atitoli(11) = " Estr. "
            atitoli(12) = " -1 "
            atitoli(13) = " -2 "
            atitoli(14) = " -3 "
            atitoli(15) = " -4 "
            atitoli(16) = " -5 "
            atitoli(17) = " -6 "
            atitoli(18) = " -7 "
            atitoli(19) = " -8 "
            atitoli(20) = " -9 "
            atitoli(21) = " -10 "
            atitoli(22) = " Estr. "
            atitoli(23) = " +2 "
            atitoli(24) = " +3 "
            atitoli(25) = " +4 "
            atitoli(26) = " +5 "
            atitoli(27) = " +6 "
            atitoli(28) = " +7 "
            atitoli(29) = " +8 "
            atitoli(30) = " +9 "
            atitoli(31) = " +10 "
            atitoli(32) = " +11 "
            atitoli(33) = " I.C. "
            atitoli(34) = " Media uscita "
            atitoli(35) = " Stringa estratti "
            atitoli(36) = " Ultima ESTR_Esito "
            Call InitTabella(atitoli,2,,2,5)
            a(01) = "01-02"
            a(02) = "03-04"
            a(03) = "05-06"
            a(04) = "07-08"
            a(05) = "09-10"
            a(06) = "11-12"
            a(07) = "13-14"
            a(08) = "15-16"
            a(09) = "17-18"
            a(10) = "19-20"
            a(11) = "21-22"
            a(12) = "23-24"
            a(13) = "25-26"
            a(14) = "27-28"
            a(15) = "29-30"
            a(16) = "31-32"
            a(17) = "33-34"
            a(18) = "35-36"
            a(19) = "37-38"
            a(20) = "39-40"
            a(21) = "41-42"
            a(22) = "43-44"
            a(23) = "45-46"
            a(24) = "47-48"
            a(25) = "49-50"
            a(26) = "51-52"
            a(27) = "53-54"
            a(28) = "55-56"
            a(29) = "57-58"
            a(30) = "59-60"
            a(31) = "61-62"
            a(32) = "63-64"
            a(33) = "65-66"
            a(34) = "67-68"
            a(35) = "69-70"
            a(36) = "71-72"
            a(37) = "73-74"
            a(38) = "75-76"
            a(39) = "77-78"
            a(40) = "79-80"
            a(41) = "81-82"
            a(42) = "83-84"
            a(43) = "85-86"
            a(44) = "87-88"
            a(45) = "89-90"
            '--------------------------------------------------------------------
            For N = 1 To UBound(a)
               Nu = Split("0-" &(a(n)),"-")
               '------ posizioni di ritardo -----------------
               For p = 1 To 5
                  ReDim aPos(5)
                  aPos(p) = True
                  'rd = EstrattoRitardo(Ru(1),a(n),Ini,fin,,,aPos)
                  rd = RitardoCombinazione(aRuote,nu,1,0,aPos)
                  ReDim Preserve pos(p)
                  pos(p) = rd
               Next
               '----------------------------------------------
               Call StatisticaFormazioneTurbo(nu,aRuote,sorte,rit,max,Incr,fre,Ini,fin)
               Call VerificaEsito(nu,aRuote,fin - rit,sorte,,Nothing,retesito,,retestratti)
               Call VerificaEsito(nu,aRuote,EstrazioneFin,1,,Nothing,esitoF,,estrF)
               'aaa = SerieFreq(EstrazioneFin,EstrazioneFin,nu,aRuote,1)
               Call StatisticaFormazioneTurbo(nu,aRuote,1,ritP,maxP,IncrP,aaa,fin,fin,,aPos)
               bbb = SerieFreq(EstrazioneFin - 1,EstrazioneFin - 1,nu,aRuote,1)
               ccc = SerieFreq(EstrazioneFin - 2,EstrazioneFin - 2,nu,aRuote,1)
               ddd = SerieFreq(EstrazioneFin - 3,EstrazioneFin - 3,nu,aRuote,1)
               eee = SerieFreq(EstrazioneFin - 4,EstrazioneFin - 4,nu,aRuote,1)
               fff = SerieFreq(EstrazioneFin - 5,EstrazioneFin - 5,nu,aRuote,1)
               ggg = SerieFreq(EstrazioneFin - 6,EstrazioneFin - 6,nu,aRuote,1)
               hhh = SerieFreq(EstrazioneFin - 7,EstrazioneFin - 7,nu,aRuote,1)
               iii = SerieFreq(EstrazioneFin - 8,EstrazioneFin - 8,nu,aRuote,1)
               lll = SerieFreq(EstrazioneFin - 9,EstrazioneFin - 9,nu,aRuote,1)
               mmm = SerieFreq(EstrazioneFin - 10,EstrazioneFin - 10,nu,aRuote,1)
               'End If
               If fre > 0 Then
                  ReDim avalori(36)
                  avalori(01) = " Dec. " & Format2(n)
                  avalori(02) = StringaNumeri(nu)
                  avalori(03) = rit
                  avalori(04) = max
                  avalori(5) = pos(1)
                  avalori(6) = pos(2)
                  avalori(7) = pos(3)
                  avalori(8) = pos(4)
                  avalori(9) = pos(5)
                  avalori(10) = pos(1) + pos(2) + pos(3) + pos(4) + pos(5)
                  avalori(11) = aaa
                  avalori(12) = bbb
                  avalori(13) = ccc
                  avalori(14) = ddd
                  avalori(15) = eee
                  avalori(16) = fff
                  avalori(17) = ggg
                  avalori(18) = hhh
                  avalori(19) = iii
                  avalori(20) = lll
                  avalori(21) = mmm
                  avalori(22) = aaa
                  avalori(23) = aaa + bbb
                  avalori(24) = aaa + bbb + ccc
                  avalori(25) = aaa + bbb + ccc + ddd
                  avalori(26) = aaa + bbb + ccc + ddd + eee
                  avalori(27) = aaa + bbb + ccc + ddd + eee + fff
                  avalori(28) = aaa + bbb + ccc + ddd + eee + fff + ggg
                  avalori(29) = aaa + bbb + ccc + ddd + eee + fff + ggg + hhh
                  avalori(30) = aaa + bbb + ccc + ddd + eee + fff + ggg + hhh + iii
                  avalori(31) = aaa + bbb + ccc + ddd + eee + fff + ggg + hhh + iii + lll
                  avalori(32) = aaa + bbb + ccc + ddd + eee + fff + ggg + hhh + iii + lll + mmm
                  avalori(33) = Round(qt/fre,2)
                  avalori(34) = Round(fre/qt*rit,2)
                  avalori(35) = retestratti
                  avalori(36) = esitoF & " : " & estrF
                  Call AddRigaTabella(avalori)
               End If
               For x = 1 To 36
                  If n = color Then Call SetColoreCella((x),3,1)
               Next
               For y = 5 To 9
                  If avalori(3) = avalori(y) Then Call SetColoreCella((y),4,2)
               Next
            Next
         End If
      Next
   End If
   Call SetTableWidth("100%")
   If qualeTab = 1 Then Call CreaTabella(10)
   If qualeTab = 2 Then Call CreaTabellaOrdinabile(10)
   If qualeTab > 2 Then MsgBox " errore digit Tabella"
   PicClear
   Call PicStampaTesto(1,10,"Script by Mike58 ",,1,1,,11,vbRed)
   PicEsegui
End Sub

ppaaoolloo · 17 Novembre 2020

Ciao Mike, non so più come ringraziarti, le parole ormai non bastano più, la tua generosità il tuo impegno e la tua disponibilità sono esemplari. Lo proverò subito e se faccio il colpaccio mi ricorderò di te.
Ti auguro buona salute e buona vita.
Salutoni

Cerca

Cerca

aggiunta di alcune colonne allo script di mike

ppaaoolloo

Super Member >PLATINUM<

Mike58

Advanced Member >PLATINUM PLUS<

ppaaoolloo

Super Member >PLATINUM<

Ultima estrazione Lotto

Ultimi Messaggi