ppaaoolloo
Super Member >PLATINUM<
salve
questo script che poi segue gentilmente fatto da Mike 58
solitamente lo uso con 2 numeri consecutivi e funziona bene,
ho provato a variarlo con 3 numeri consecutivi ma i risultati sono errati
qualcuno potrebbe verificarmelo ed eventualmente correggerlo
ringrazio anticipatamente
'Option Explicit
Sub Main
Dim Tipoarchivio
Tipoarchivio = ScegliArchivioDL
If Tipoarchivio > 00 Then
If Tipoarchivio = 02 Then
If MsgBox("Vuoi aggiornare le estrazioni prima di eseguire il listato",vbQuestion + vbYesNo) = vbYes Then
Call AggiornaArchivioDL
End If
End If
Call ImpostaArchivio10ELotto(Tipoarchivio)
Dim qualetab,qt
Dim sorte,color
qualetab = CInt(InputBox("QUALE TABELLA","1 = Tab Normale 2 = Tab excel",2))
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
Dim Ini,fin
fin = EstrazioneFin
Ini = EstrazioneFin - qt
If Tipoarchivio = 01 Then Call Scrivi("ARCHIVIO 10 e Lotto Serale ",01)
If Tipoarchivio = 02 Then Call Scrivi("ARCHIVIO 10 e Lotto 5 Minuti ",01)
Call Scrivi(" dal " & DataEstrazioneDL(Ini) & " al " & DataEstrazioneDL(fin),01)
Call Scrivi("Sorte analizzata..." & NomeSorte(sorte),01,01,,01,03)
Call Scrivi()
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)
Dim a(90)
a(01) = "01-02-03"
a(02) = "02-03-04"
a(03) = "03-04-05"
a(04) = "04-05-06"
a(05) = "05-06-07"
a(06) = "06-07-08"
a(07) = "07-08-09"
a(08) = "08-09-10"
a(09) = "09-10-11"
a(10) = "10-11-12"
a(11) = "11-12-13"
a(12) = "12-13-14"
a(13) = "13-14-15"
a(14) = "14-15-16"
a(15) = "15-16-17"
a(16) = "16-17-18"
a(17) = "17-18-19"
a(18) = "18-19-20"
a(19) = "19-20-21"
a(20) = "20-21-22"
a(21) = "21-22-23"
a(22) = "22-23-24"
a(23) = "23-24-25"
a(24) = "24-25-26"
a(25) = "25-26-27"
a(26) = "26-27-28"
a(27) = "27-28-29"
a(28) = "28-29-30"
a(29) = "29-30-31"
a(30) = "30-31-32"
a(31) = "31-32-33"
a(32) = "32-33-34"
a(33) = "33-34-35"
a(34) = "34-35-36"
a(35) = "35-36-37"
a(36) = "36-37-38"
a(37) = "37-38-39"
a(38) = "38-39-40"
a(39) = "39-40-41"
a(40) = "40-41-42"
a(41) = "41-42-43"
a(42) = "42-43-44"
a(43) = "43-44-45"
a(44) = "44-45-46"
a(45) = "45-46-47"
a(46) = "46-47-48"
a(47) = "47-48-49"
a(48) = "48-49-50"
a(49) = "49-50-51"
a(50) = "50-51-52"
a(51) = "51-52-53"
a(52) = "52-53-54"
a(53) = "53-54-55"
a(54) = "54-55-56"
a(55) = "55-56-57"
a(56) = "56-57-58"
a(57) = "57-58-59"
a(58) = "58-59-60"
a(59) = "59-60-61"
a(60) = "60-61-62"
a(61) = "61-62-63"
a(62) = "62-63-64"
a(63) = "63-64-65"
a(64) = "64-65-66"
a(65) = "65-66-67"
a(66) = "66-67-68"
a(67) = "67-68-69"
a(68) = "68-69-70"
a(69) = "69-70-71"
a(70) = "70-71-72"
a(71) = "71-72-73"
a(72) = "72-73-74"
a(73) = "73-74-75"
a(74) = "74-75-76"
a(75) = "75-76-77"
a(76) = "76-77-78"
a(77) = "77-78-79"
a(78) = "78-79-80"
a(79) = "79-80-81"
a(80) = "80-81-82"
a(81) = "81-82-83"
a(82) = "82-83-84"
a(83) = "83-84-85"
a(84) = "84-85-86"
a(85) = "85-86-87"
a(86) = "86-87-88"
a(87) = "87-88-89"
a(88) = "88-89-90"
a(89) = "89-90-01"
a(90) = "90-01-02"
'--------------------------------------------------------------------
Dim n,nu
For n = 01 To UBound(a)
nu = Split("00." & a,".")
Dim rit,max,Incr,fre
Dim retesito,colpi,retestratti,retid
Dim esitoF,estrF
Call StatisticaFormazioneDL(nu,sorte,rit,max,Incr,fre,Ini,fin)
Call VerificaEsitoDL(nu,fin - rit,sorte,10,retesito,colpi,retestratti,retid)
Call VerificaEsitoDL(nu,fin,AMBATA_,,esitoF,,estrF)
aaa = SerieFreqDL(fin,fin,nu,AMBATA_)
bbb = SerieFreqDL(fin - 01,fin - 01,nu,AMBATA_)
ccc = SerieFreqDL(fin - 02,fin - 02,nu,AMBATA_)
ddd = SerieFreqDL(fin - 03,fin - 03,nu,AMBATA_)
eee = SerieFreqDL(fin - 04,fin - 04,nu,AMBATA_)
fff = SerieFreqDL(fin - 05,fin - 05,nu,AMBATA_)
ggg = SerieFreqDL(fin - 06,fin - 06,nu,AMBATA_)
hhh = SerieFreqDL(fin - 07,fin - 07,nu,AMBATA_)
iii = SerieFreqDL(fin - 08,fin - 08,nu,AMBATA_)
lll = SerieFreqDL(fin - 09,fin - 09,nu,AMBATA_)
mmm = SerieFreqDL(fin - 10,fin - 10,nu,AMBATA_)
If fre >= 00 Then
ReDim avalori(30)
Dim aaa,bbb,ccc,ddd,eee,fff,ggg,hhh,iii,lll,mmm
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,,,02)
End If
Dim x
For x = 01 To 16
If n = color Then Call SetColoreCella((x),03,01)
Next
Next
Call SetTableWidth("100%")
If qualetab = 01 Then Call CreaTabella(03)
If qualetab = 02 Then Call CreaTabellaOrdinabile(03)
If qualetab > 02 Then Call MsgBox(" errore digit Tabella")
PicClear
Call PicStampaTesto(01,10,"Script by Mike58 ",,01,01,,11,vbRed)
PicEsegui
End If
End Sub
Function ScegliArchivioDL()
ReDim aVoci(01)
aVoci(00) = "10 e lotto Serale"
aVoci(01) = "10 e lotto 5minuti"
ScegliArchivioDL = ScegliOpzioneMenu(aVoci,00,"Scegli archivio 10eLotto") + 01
End Function
questo script che poi segue gentilmente fatto da Mike 58
solitamente lo uso con 2 numeri consecutivi e funziona bene,
ho provato a variarlo con 3 numeri consecutivi ma i risultati sono errati
qualcuno potrebbe verificarmelo ed eventualmente correggerlo
ringrazio anticipatamente
'Option Explicit
Sub Main
Dim Tipoarchivio
Tipoarchivio = ScegliArchivioDL
If Tipoarchivio > 00 Then
If Tipoarchivio = 02 Then
If MsgBox("Vuoi aggiornare le estrazioni prima di eseguire il listato",vbQuestion + vbYesNo) = vbYes Then
Call AggiornaArchivioDL
End If
End If
Call ImpostaArchivio10ELotto(Tipoarchivio)
Dim qualetab,qt
Dim sorte,color
qualetab = CInt(InputBox("QUALE TABELLA","1 = Tab Normale 2 = Tab excel",2))
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
Dim Ini,fin
fin = EstrazioneFin
Ini = EstrazioneFin - qt
If Tipoarchivio = 01 Then Call Scrivi("ARCHIVIO 10 e Lotto Serale ",01)
If Tipoarchivio = 02 Then Call Scrivi("ARCHIVIO 10 e Lotto 5 Minuti ",01)
Call Scrivi(" dal " & DataEstrazioneDL(Ini) & " al " & DataEstrazioneDL(fin),01)
Call Scrivi("Sorte analizzata..." & NomeSorte(sorte),01,01,,01,03)
Call Scrivi()
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)
Dim a(90)
a(01) = "01-02-03"
a(02) = "02-03-04"
a(03) = "03-04-05"
a(04) = "04-05-06"
a(05) = "05-06-07"
a(06) = "06-07-08"
a(07) = "07-08-09"
a(08) = "08-09-10"
a(09) = "09-10-11"
a(10) = "10-11-12"
a(11) = "11-12-13"
a(12) = "12-13-14"
a(13) = "13-14-15"
a(14) = "14-15-16"
a(15) = "15-16-17"
a(16) = "16-17-18"
a(17) = "17-18-19"
a(18) = "18-19-20"
a(19) = "19-20-21"
a(20) = "20-21-22"
a(21) = "21-22-23"
a(22) = "22-23-24"
a(23) = "23-24-25"
a(24) = "24-25-26"
a(25) = "25-26-27"
a(26) = "26-27-28"
a(27) = "27-28-29"
a(28) = "28-29-30"
a(29) = "29-30-31"
a(30) = "30-31-32"
a(31) = "31-32-33"
a(32) = "32-33-34"
a(33) = "33-34-35"
a(34) = "34-35-36"
a(35) = "35-36-37"
a(36) = "36-37-38"
a(37) = "37-38-39"
a(38) = "38-39-40"
a(39) = "39-40-41"
a(40) = "40-41-42"
a(41) = "41-42-43"
a(42) = "42-43-44"
a(43) = "43-44-45"
a(44) = "44-45-46"
a(45) = "45-46-47"
a(46) = "46-47-48"
a(47) = "47-48-49"
a(48) = "48-49-50"
a(49) = "49-50-51"
a(50) = "50-51-52"
a(51) = "51-52-53"
a(52) = "52-53-54"
a(53) = "53-54-55"
a(54) = "54-55-56"
a(55) = "55-56-57"
a(56) = "56-57-58"
a(57) = "57-58-59"
a(58) = "58-59-60"
a(59) = "59-60-61"
a(60) = "60-61-62"
a(61) = "61-62-63"
a(62) = "62-63-64"
a(63) = "63-64-65"
a(64) = "64-65-66"
a(65) = "65-66-67"
a(66) = "66-67-68"
a(67) = "67-68-69"
a(68) = "68-69-70"
a(69) = "69-70-71"
a(70) = "70-71-72"
a(71) = "71-72-73"
a(72) = "72-73-74"
a(73) = "73-74-75"
a(74) = "74-75-76"
a(75) = "75-76-77"
a(76) = "76-77-78"
a(77) = "77-78-79"
a(78) = "78-79-80"
a(79) = "79-80-81"
a(80) = "80-81-82"
a(81) = "81-82-83"
a(82) = "82-83-84"
a(83) = "83-84-85"
a(84) = "84-85-86"
a(85) = "85-86-87"
a(86) = "86-87-88"
a(87) = "87-88-89"
a(88) = "88-89-90"
a(89) = "89-90-01"
a(90) = "90-01-02"
'--------------------------------------------------------------------
Dim n,nu
For n = 01 To UBound(a)
nu = Split("00." & a,".")
Dim rit,max,Incr,fre
Dim retesito,colpi,retestratti,retid
Dim esitoF,estrF
Call StatisticaFormazioneDL(nu,sorte,rit,max,Incr,fre,Ini,fin)
Call VerificaEsitoDL(nu,fin - rit,sorte,10,retesito,colpi,retestratti,retid)
Call VerificaEsitoDL(nu,fin,AMBATA_,,esitoF,,estrF)
aaa = SerieFreqDL(fin,fin,nu,AMBATA_)
bbb = SerieFreqDL(fin - 01,fin - 01,nu,AMBATA_)
ccc = SerieFreqDL(fin - 02,fin - 02,nu,AMBATA_)
ddd = SerieFreqDL(fin - 03,fin - 03,nu,AMBATA_)
eee = SerieFreqDL(fin - 04,fin - 04,nu,AMBATA_)
fff = SerieFreqDL(fin - 05,fin - 05,nu,AMBATA_)
ggg = SerieFreqDL(fin - 06,fin - 06,nu,AMBATA_)
hhh = SerieFreqDL(fin - 07,fin - 07,nu,AMBATA_)
iii = SerieFreqDL(fin - 08,fin - 08,nu,AMBATA_)
lll = SerieFreqDL(fin - 09,fin - 09,nu,AMBATA_)
mmm = SerieFreqDL(fin - 10,fin - 10,nu,AMBATA_)
If fre >= 00 Then
ReDim avalori(30)
Dim aaa,bbb,ccc,ddd,eee,fff,ggg,hhh,iii,lll,mmm
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,,,02)
End If
Dim x
For x = 01 To 16
If n = color Then Call SetColoreCella((x),03,01)
Next
Next
Call SetTableWidth("100%")
If qualetab = 01 Then Call CreaTabella(03)
If qualetab = 02 Then Call CreaTabellaOrdinabile(03)
If qualetab > 02 Then Call MsgBox(" errore digit Tabella")
PicClear
Call PicStampaTesto(01,10,"Script by Mike58 ",,01,01,,11,vbRed)
PicEsegui
End If
End Sub
Function ScegliArchivioDL()
ReDim aVoci(01)
aVoci(00) = "10 e lotto Serale"
aVoci(01) = "10 e lotto 5minuti"
ScegliArchivioDL = ScegliOpzioneMenu(aVoci,00,"Scegli archivio 10eLotto") + 01
End Function