Ciao Rubino.
Ho ritrovato lo script che ti avevo chiesto ma che è mancante di una parte.
Puoi per favore ricompletarlo così lo posso usare? Grazie.
Post in data 25/5/2011 h. 11.37:
Ho ritrovato lo script che ti avevo chiesto ma che è mancante di una parte.
Puoi per favore ricompletarlo così lo posso usare? Grazie.
Post in data 25/5/2011 h. 11.37:
Codice:
'ABASUL calcola scarto medio quadratico con formula guidata di una serie di ritardi precedenti - attuale - futuro
'''ABASUL4
Sub Main()
Dim numeri
Dim nu(90)
Dim rita
Dim ritf
Call ScegliNumeri(nu)
For h = 1 To UBound(nu)
numeri = numeri & nu(h) & " "
Next
rita = InputBox("Inserisci ritardo attuale...",,"")
ritf = InputBox("Inserisci ritardo futuro....",,"")
Dim nome
nome = "C:\Documents And Settings\Pietro\Dati applicazioni\spaziometria\temp\ListView2.txt"
lancio = Getleggifile(nome,numeri,rita,ritf)
End Sub
''''-------------------------------------------------------------------------------------------------------------------------
Function Getleggifile(nome,numeri,rita,ritf)
'leggo file(tutti i record dello sviluppo ridotto richiesto)
Dim namefile
Dim sFile
ReDim aRighe(0)
ReDim asvil(0)
Dim art(1)
Dim dif(900)
Dim xbas
Dim t
Dim Media
Dim r
namefile = nome
sFile = namefile
LeggiRigheFileDiTesto sFile,asvil
'ricerca last record e qta tot.record.presenti nel file
xbas = UBound(asvil)
''''''per controllo iniziale suddivisione campi e righe
For u = 1 To xbas
'scompongo riga con campi divisi da separatore
Dim d
ReDim Nums(10)
ReDim aV(0)
Call SplitByChar(asvil(u),";",aV) ' scompongo la decina
Nums(1) = aV(0)
Nums(2) = aV(1)
Nums(3) = aV(2)
Nums(4) = aV(3)
Nums(5) = aV(4)
Nums(6) = aV(5)
nus = Nums(1) & " " & Nums(2) & " " & Nums(3) & " " & Nums(4) & " " & Nums(5) & " " & Nums(6)
Scrivi nus
tq = tq + CLng(aV(4))
r = aV(2)
If u = xbas Then
ColoreTesto 1
ultusc = Left(aV(1),5)
Scrivi "ultima uscita..n.conc.." & Left(aV(1),5),1
ColoreTesto 0
Mediarealep = Int(Left(aV(1),5)) / u
Mediarealea = EstrazioneFin /(u + 1)
End If
Next
''''''''-----------------------------------------------------------------------------------------------------------
t = xbas
Media = tq / t
t2 = t + 1
''' per completare il quadro informazioni
art(1) = aV(2)
ColoreTesto 2
Scrivi " Situazione ruota di " & r
Scrivi " Ritardo Attuale...." & rita
Scrivi " Ritardo Futuro....." & ritf
Scrivi " Elementi ritardo letti da statistica n. " & t
ColoreTesto 1
Scrivi " Per i numeri richiesti...." & numeri
ColoreTesto 0
Scrivi " Calcola Scarto Medio Quadratico in 3 Eventi distinti "
Scrivi "_________________________________________________ ____________________"
ReDim atitoli(30)
' preimposto i titoli delle colonne
atitoli(1) = " Ruota "
atitoli(2) = " Numeri "
atitoli(3) = " R.attuale "
atitoli(4) = " R.Futuro "
atitoli(5) = " Somma RPrec "
atitoli(6) = " Media Rt.prec."
atitoli(7) = " Smq Rt.Prec."
atitoli(8) = " Somma RAtt. "
atitoli(9) = " Media Rt.Att. "
atitoli(10) = " Smq Rt.Att. "
atitoli(11) = " Somma RFut. "
atitoli(12) = " Media Rt.Futuro"
atitoli(13) = " Smq Rt.Futuro"
' inizializzo la tabella
Call InitTabella(atitoli,1,"center",2,5)
' preimposto un array di comodo per creare la nuova riga da aggiungere alla tabella
ReDim aValori(30) '
avalori(1) = r
avalori(2) = numeri
avalori(3) = rita
avalori(4) = ritf
For z = 1 To t
ReDim av2(0)
Call SplitByChar(asvil(z),";",av2)
If Int(Media) > CLng(av2(4)) Then
dif(z) = Media - CLng(av2(4))
Else
dif(z) = CLng(av2(4)) - Media
End If
quadro = dif(z) * dif(z)
Totqua = Totqua + CLng(quadro)
'''''' Scrivi z & " ra." & av2(4) & " md." & Media & " scostamento..." & dif(z) & " quadro.." & quadro
Next
''''--------------------------------------------------------------------------------------------------------------------
'''calcola sqm e medie
smq1 = Sqr(Totqua/t)
ColoreTesto 2
Scrivi
Scrivi " Esempio: FORMULA APPLICATA: Totale...." & Totqua & "./..n.elementi ritardo..." & t & ".....media..." & round((Totqua/t),6) & "...radice quadrata..." & smq1
Scrivi
ColoreTesto 0
tq0 = Totqua
dp0 = quadro
Media0 = round(Totqua/t)
md1 =(tq / t)
te1 = tq
avalori(5) =
