ppaaoolloo
Super Member >PLATINUM<
Salve
metto qui sotto uno script che gentilmente Ilegend mi aveva fatto un po'
di tempo fa, con la possibilità di poter avere dei numeri consecutivi per ambi
oppure terzine oppure quaterne ecc.
se possibile vorrei una variazione nella ricerca dei numeri,
vorrei la possibilità mantenendo sempre lo stesso metodo ma di poter
aggiungere un'altra opzione nella ricerca
cioè quella di poter trovare solo i numeri dispari o solo i numeri dispari
sempre consecutivi
(ad esempio selezionando il terno dei numeri può uscire 11-13-15 oppure
25-27-29 ecc. oppure per ambi pari potrebbe uscire 10-12 oppure 46-48 ecc.)
confido ancora nella sua disponibilità e pazienza tenendo conto che si possa fare
e spero che ne abbia il tempo e la voglia di rimetterci mano
ringrazio anticipatamente
il tempo
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,RGB(255,217,236))
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
metto qui sotto uno script che gentilmente Ilegend mi aveva fatto un po'
di tempo fa, con la possibilità di poter avere dei numeri consecutivi per ambi
oppure terzine oppure quaterne ecc.
se possibile vorrei una variazione nella ricerca dei numeri,
vorrei la possibilità mantenendo sempre lo stesso metodo ma di poter
aggiungere un'altra opzione nella ricerca
cioè quella di poter trovare solo i numeri dispari o solo i numeri dispari
sempre consecutivi
(ad esempio selezionando il terno dei numeri può uscire 11-13-15 oppure
25-27-29 ecc. oppure per ambi pari potrebbe uscire 10-12 oppure 46-48 ecc.)
confido ancora nella sua disponibilità e pazienza tenendo conto che si possa fare
e spero che ne abbia il tempo e la voglia di rimetterci mano
ringrazio anticipatamente
il tempo
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,RGB(255,217,236))
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
