Sub Main
Dim Namefile,last,x,y,z,lastnr
Dim r,ctr,ctz,Ord
Dim rBA,rCA,rFI,rGE,rMI,rNA,rPA,rRO,rTO,rVE,rNZ
Dim rTT,Ftt,tsomma,minmin,Totmin
Dim BARI(8990),CAGLIARI(8990),FIRENZE(8990),GENOVA(8990),MILANO(8990),NAPOLI(8990),PALERMO(8990),ROMA(8990),TORINO(8990),VENEZIA(8990)
Dim Total(11),tsomver(11),amin(11),rspever(11)
Dim al,f,tmin,somgen,ctv
Dim ct,lim,nrt
ReDim arighe(0)
ReDim av(0)
Ord = CInt(InputBox("Ordina colonna 2=Ambo 4=Rit.Tutte 19=Rit.Specifico 20=Rit.Minimo",,20))
lim = CInt(InputBox("Limite Ritardo Minimo Evidenziato ",,500))
nrt = 1
''''legge file guida.txt per caricare in arrays le combinazioni personali
Namefile = "C:\Temp\Guida.txt"
sFile = Namefile
LeggiRigheFileDiTesto sFile,arighe
last = UBound(arighe)
Dim nsorte,dal,ruota
ColoreTesto(0)
nsorte = 2
For f = 1 To 10
amin(f) = 9999
Next
dal = 1 ' inizio tutte le altre ruote
If r = 12 Then dal = 7440 'inizio nazionale
If r = 1 Then dal = 174 'inizio bari
If r = 2 Then dal = 3649 'inizio cagliari
If r = 4 Then dal = 3577 'inizio genova
If r <> 11 Then ruota = NomeRuota(r) Else ruota = "T U T T E"
ColoreTesto(1)
Scrivi " Situazione Statistica Ritardo degli ambi nelle 11 Ruote e visione a TUTTE",1
Scrivi " Periodo considerato : dal " & dal & " - " & DataEstrazione(dal) & " al " & EstrazioneFin & " - " & DataEstrazione(EstrazioneFin),1
Scrivi " Ordina output video per la colonna n. " & Ord & " scriptname=Rubino x Rosa ",1
Scrivi " Evidenzia Ritardi Orizzontali maggiori a " & lim,1
Scrivi "___________________________________________________________________________________________________________________________________",1
ColoreTesto(0)
ReDim atitoli(20)
' preimposto i titoli delle colonne
atitoli(1) = ruota
atitoli(2) = " Ambo "
atitoli(3) = " Freque "
atitoli(4) = " Ritardo "
atitoli(5) = " Rit.BA "
atitoli(6) = " Rit.CA "
atitoli(7) = " Rit.FI "
atitoli(8) = " Rit.GE "
atitoli(9) = " Rit.MI "
atitoli(10) = " Rit.NA "
atitoli(11) = " Rit.PA "
atitoli(12) = " Rit.RO "
atitoli(13) = " Rit.TO "
atitoli(14) = " Rit.VE "
atitoli(15) = " Rit.NZ "
atitoli(16) = " Nr.Ambi"
atitoli(17) = " Somma R."
atitoli(18) = " RS=(SR+(Sm*(ct-1))/ct)"
atitoli(19) = " Rit.Spec"
atitoli(20) = " Rit.Min.Cond."
' inizializzo la tabella
Call InitTabella(atitoli,2,"center",2,5,"Calibri")
'''''''-------------------------------------------------------------------------------------------------------------------------
'scompongo dati utente per identificare combinazione
For y = 0 To last
ReDim av(0)
Call SplitByChar(arighe(y)," ",av)
lastnr = UBound(av)
ReDim avalori(20)
ReDim aNum(3)
If lastnr < 3 Then
aNum(1) = Format2(av(0))
aNum(2) = Format2(av(1))
aNum(3) = ""
Else
aNum(1) = Format2(av(0))
aNum(2) = Format2(av(1))
aNum(3) = Format2(av(2))
End If
avalori(1) = " T u t t e "
avalori(2) = Format2(aNum(1)) & " " & Format2(aNum(2))
Call Messaggio(NomeRuota(r) & "...Elabora Combinazione..." & Format2(aNum(1)) & " " & Format2(aNum(2)) & " " & Format2(aNum(3)))
Call AvanzamentoElab(1,90,a)
If ScriptInterrotto Then Exit For
ReDim aRt(1)
aRt(1) = r
If nsorte > 0 Then
Ftt = AmboFrequenza(11,aNum(1),aNum(2),dal,al)
avalori(3) = Ftt
rTT = AmboRitardo(11,aNum(1),aNum(2),dal,al)
avalori(4) = rTT
'''recupera ritardo su ruote fisse
rBA = AmboRitardo(1,aNum(1),aNum(2),dal,al)
rCA = AmboRitardo(2,aNum(1),aNum(2),dal,al)
rFI = AmboRitardo(3,aNum(1),aNum(2),dal,al)
rGE = AmboRitardo(4,aNum(1),aNum(2),dal,al)
rMI = AmboRitardo(5,aNum(1),aNum(2),dal,al)
rNA = AmboRitardo(6,aNum(1),aNum(2),dal,al)
rPA = AmboRitardo(7,aNum(1),aNum(2),dal,al)
rRO = AmboRitardo(8,aNum(1),aNum(2),dal,al)
rTO = AmboRitardo(9,aNum(1),aNum(2),dal,al)
rVE = AmboRitardo(10,aNum(1),aNum(2),dal,al)
rNZ = AmboRitardo(12,aNum(1),aNum(2),dal,al)
'''carico campi tabella
avalori(5) = rBA
avalori(6) = rCA
avalori(7) = rFI
avalori(8) = rGE
avalori(9) = rMI
avalori(10) = rNA
avalori(11) = rPA
avalori(12) = rRO
avalori(13) = rTO
avalori(14) = rVE
avalori(15) = rNZ
'''' carico per ogni ruota i ritardi degli ambi
If aNum(1) < aNum(2) Then ambo = Format2(aNum(1)) & Format2(aNum(2)) Else ambo = Format2(aNum(2)) & Format2(aNum(1)) End If
BARI(ambo) = rBA
CAGLIARI(ambo) = rCA
FIRENZE(ambo) = rFI
GENOVA(ambo) = rGE
MILANO(ambo) = rMI
NAPOLI(ambo) = rNA
PALERMO(ambo) = rPA
ROMA(ambo) = rRO
TORINO(ambo) = rTO
VENEZIA(ambo) = rVE
tsomma = 0
ct = 0
minmin = 99999
For q = 5 To 14
If Int(avalori(q)) > lim Then
ct = ct + 1
tsomma = tsomma + avalori(q)
If Int(avalori(q)) < minmin Then
minmin = avalori(q)
End If
End If
Next
If ct >= nrt Then
avalori(16) = ct
avalori(17) = tsomma
'''calcola ritardo specifico formula rs = tsomma + (minmin * (ct-1)) / ct)
Totmin = Int(minmin *(ct - 1))
avalori(18) = Int(avalori(17)) + Int(Totmin)
avalori(19) = Int(avalori(18) / ct)
avalori(20) = 99999
'''''totalizzo quanti ambi con ritardo maggiore del limite per ogni ruota
If avalori(5) > lim Then
Total(1) = Total(1) + 1
If avalori(5) < avalori(20) Then
avalori(20) = avalori(5)
End If
End If
If avalori(6) > lim Then
Total(2) = Total(2) + 1
If avalori(6) < avalori(20) Then
avalori(20) = avalori(6)
End If
End If
If avalori(7) > lim Then
Total(3) = Total(3) + 1
If avalori(7) < avalori(20) Then
avalori(20) = avalori(7)
End If
End If
If avalori(8) > lim Then
Total(4) = Total(4) + 1
If avalori(8) < avalori(20) Then
avalori(20) = avalori(8)
End If
End If
If avalori(9) > lim Then
Total(5) = Total(5) + 1
If avalori(9) < avalori(20) Then
avalori(20) = avalori(9)
End If
End If
If avalori(10) > lim Then
Total(6) = Total(6) + 1
If avalori(10) < avalori(20) Then
avalori(20) = avalori(10)
End If
End If
If avalori(11) > lim Then
Total(7) = Total(7) + 1
If avalori(11) < avalori(20) Then
avalori(20) = avalori(11)
End If
End If
If avalori(12) > lim Then
Total(8) = Total(8) + 1
If avalori(12) < avalori(20) Then
avalori(20) = avalori(12)
End If
End If
If avalori(13) > lim Then
Total(9) = Total(9) + 1
If avalori(13) < avalori(20) Then
avalori(20) = avalori(13)
End If
End If
If avalori(14) > lim Then
Total(10) = Total(10) + 1
If avalori(14) < avalori(20) Then
avalori(20) = avalori(14)
End If
End If
If avalori(15) > lim Then
Total(11) = Total(11) + 1
End If
'''conta n.ambi filtrati
Call AddRigaTabella(avalori,Giallo_,"center",1)
Call SetColoreCella(1,vbWhite,vbBlack)
Call SetColoreCella(5,vbWhite,vbBlue)
Call SetColoreCella(6,vbWhite,vbBlue)
Call SetColoreCella(7,vbWhite,vbBlue)
Call SetColoreCella(8,vbWhite,vbBlue)
Call SetColoreCella(9,vbWhite,vbBlue)
Call SetColoreCella(10,vbWhite,vbBlue)
Call SetColoreCella(11,vbWhite,vbBlue)
Call SetColoreCella(12,vbWhite,vbBlue)
Call SetColoreCella(13,vbWhite,vbBlue)
Call SetColoreCella(14,vbWhite,vbBlue)
Call SetColoreCella(15,vbWhite,vbBlue)
Call SetColoreCella(16,vbRed,vbWhite)
Call SetColoreCella(20,vbWhite,vbBlack)
Call SetColoreCella(4,RGB(181,253,245),vbBlack)
Call SetColoreCella(2,RGB(181,253,245),vbBlack)
Call SetColoreCella(3,vbWhite,vbBlack)
If avalori(16) >= nrt + 1 Then
Call SetColoreCella(16,RGB(120,050,150),vbWhite)
End If
If avalori(5) >= lim Then
Call SetColoreCella(5,vbGreen,vbBlack)
tsomver(1) = tsomver(1) + avalori(5)
If avalori(5) < amin(1) Then
amin(1) = avalori(5)
End If
End If
If avalori(6) >= lim Then
Call SetColoreCella(6,vbGreen,vbBlack)
tsomver(2) = tsomver(2) + avalori(6)
If avalori(6) < amin(2) Then
amin(2) = avalori(6)
End If
End If
If avalori(7) >= lim Then
Call SetColoreCella(7,vbGreen,vbBlack)
tsomver(3) = tsomver(3) + avalori(7)
If avalori(7) < amin(3) Then
amin(3) = avalori(7)
End If
End If
If avalori(8) >= lim Then
Call SetColoreCella(8,vbGreen,vbBlack)
tsomver(4) = tsomver(4) + avalori(8)
If avalori(8) < amin(4) Then
amin(4) = avalori(8)
End If
End If
If avalori(9) >= lim Then
Call SetColoreCella(9,vbGreen,vbBlack)
tsomver(5) = tsomver(5) + avalori(9)
If avalori(9) < amin(5) Then
amin(5) = avalori(9)
End If
End If
If avalori(10) >= lim Then
Call SetColoreCella(10,vbGreen,vbBlack)
tsomver(6) = tsomver(6) + avalori(10)
If avalori(10) < amin(6) Then
amin(6) = avalori(10)
End If
End If
If avalori(11) >= lim Then
Call SetColoreCella(11,vbGreen,vbBlack)
tsomver(7) = tsomver(7) + avalori(11)
If avalori(11) < amin(7) Then
amin(7) = avalori(11)
End If
End If
If avalori(12) >= lim Then
Call SetColoreCella(12,vbGreen,vbBlack)
tsomver(8) = tsomver(8) + avalori(12)
If avalori(12) < amin(8) Then
amin(8) = avalori(12)
End If
End If
If avalori(13) >= lim Then
Call SetColoreCella(13,vbGreen,vbBlack)
tsomver(9) = tsomver(9) + avalori(13)
If avalori(13) < amin(9) Then
amin(9) = avalori(13)
End If
End If
If avalori(14) >= lim Then
Call SetColoreCella(14,vbGreen,vbBlack)
tsomver(10) = tsomver(10) + avalori(14)
If avalori(14) < amin(10) Then
amin(10) = avalori(14)
End If
End If
If avalori(15) >= lim Then
Call SetColoreCella(15,vbGreen,vbBlack)
End If
If avalori(19) > 3000 Then
Call SetColoreCella(19,RGB(120,050,150),vbWhite)
End If
End If
End If
Next
'''carico campi tabella
avalori(1) = " Totale Vert. "
avalori(2) = " n.ambi "
avalori(3) = "R"
avalori(4) = "R"
avalori(5) = "n." & Total(1)
avalori(6) = "n." & Total(2)
avalori(7) = "n." & Total(3)
avalori(8) = "n." & Total(4)
avalori(9) = "n." & Total(5)
avalori(10) = "n." & Total(6)
avalori(11) = "n." & Total(7)
avalori(12) = "n." & Total(8)
avalori(13) = "n." & Total(9)
avalori(14) = "n." & Total(10)
avalori(15) = "n." & Total(11)
avalori(16) = "R"
avalori(17) = "R"
avalori(18) = "R"
avalori(19) = "R"
avalori(20) = "Riepil."
'''conta n.ambi verticali si ogni ruota con ritardo > lim
Call AddRigaTabella(avalori,RGB(192,192,192),"center",1)
'''calcola ritardo specifico verticale formula rs = tsomma + (minmin * (ct-1)) / ct)
For f = 1 To 10
ctv = Total(f)
If ctv - 1 > 0 Then
tmin = Int(amin(f) *(ctv - 1))
Else
tmin = 0
End If
somgen = tsomver(f) + tmin
If ctv > 0 Then
rspever(f) = Int(somgen / ctv)
Else
rspever(f) = 0
End If
Next
avalori(1) = " Rit.min.Vert. "
avalori(2) = " "
avalori(3) = "R"
avalori(4) = "R"
If amin(1) = 9999 Then amin(1) = 0 Else avalori(5) = "rm." & amin(1) End If
If amin(2) = 9999 Then amin(2) = 0 Else avalori(6) = "rm." & amin(2) End If
If amin(3) = 9999 Then amin(3) = 0 Else avalori(7) = "rm." & amin(3) End If
If amin(4) = 9999 Then amin(4) = 0 Else avalori(8) = "rm." & amin(4) End If
If amin(5) = 9999 Then amin(5) = 0 Else avalori(9) = "rm." & amin(5) End If
If amin(6) = 9999 Then amin(6) = 0 Else avalori(10) = "rm." & amin(6) End If
If amin(7) = 9999 Then amin(7) = 0 Else avalori(11) = "rm." & amin(7) End If
If amin(8) = 9999 Then amin(8) = 0 Else avalori(12) = "rm." & amin(8) End If
If amin(9) = 9999 Then amin(9) = 0 Else avalori(13) = "rm." & amin(9) End If
If amin(10) = 9999 Then amin(10) = 0 Else avalori(14) = "rm." & amin(10) End If
avalori(15) = "rm." & amin(11)
avalori(16) = "R"
avalori(17) = "R"
avalori(18) = "R"
avalori(19) = "R"
avalori(20) = "Riepil."
'''conta n.ambi verticali si ogni ruota con ritardo > lim
Call AddRigaTabella(avalori,RGB(248,248,248),"center",1)
avalori(1) = " R.Spec.Vert. "
avalori(2) = " "
avalori(3) = "R"
avalori(4) = "R"
avalori(5) = "rs." & rspever(1)
avalori(6) = "rs." & rspever(2)
avalori(7) = "rs." & rspever(3)
avalori(8) = "rs." & rspever(4)
avalori(9) = "rs." & rspever(5)
avalori(10) = "rs." & rspever(6)
avalori(11) = "rs." & rspever(7)
avalori(12) = "rs." & rspever(8)
avalori(13) = "rs." & rspever(9)
avalori(14) = "rs." & rspever(10)
avalori(15) = "rs." & rspever(11)
avalori(16) = "R"
avalori(17) = "R"
avalori(18) = "R"
avalori(19) = "R"
avalori(20) = "Riepil."
'''conta n.ambi verticali si ogni ruota con ritardo > lim
Call AddRigaTabella(avalori,RGB(192,192,192),"center",1)
For f = 5 To 14
If Int(Mid(avalori(f),4,5)) > 3000 Then
Call SetColoreCella(Int(f),RGB(120,050,150),vbWhite)
End If
Next
Call Messaggio("...Ordinamento.del Riepilogo....Attendere...")
'''ordina x ritardo att.
Call CreaTabella(Ord)
End Sub