Buonanotte,
mi hanno fatto questo lisstato .
e da provare
Option Explicit
Dim clsHSS
Sub Main
   Dim sFileArchivio : sFileArchivio = GetDirectoryAppData & "Archivio VinciCasa\VinciCasa.txt"
   Call ApriBaseDatiFT(sFileArchivio,05,",",40)
   Set clsHSS = CreateObject("HSS.ClsHighSpeedStat")
   Call clsHSS.Init(sFileArchivio,09,",",05)
   'INIZIO GIORNALIERO DataEstrToIdEstrFT(17,07,2017) [00159] [29] 17.07.2017
   Dim QT : QT = InputBox("Quante estrazioni vuoi controllar","ESTRAZIONI",30)
   Dim Ini,fin,k : Ini = EstrazioniArchivioFT - QT : fin = EstrazioniArchivioFT
   Dim sRecord : sRecord = "L'archivio letto va da " & GetInfoEstrazioneFT(Ini) & " a " & _
   GetInfoEstrazioneFT(fin) & vbCrLf
   sRecord = sRecord & "si compone di " & EstrazioniArchivioFT & " estrazioni " & vbCrLf
   sRecord = sRecord & "di seguito la lista dei ritardi e delle frequenze" & vbCrLf
   Call Scrivi(sRecord)
   Dim aTitoli : aTitoli = Array(00,"Numero","Frequenza","Ritardo")
   Call InitTabella(aTitoli,01,,,05)
   For k = 01 To 40 : Call Messaggio(k) : Call AvanzamentoElab(01,40,k)
      Dim aValori : aValori = Array(00,Format2(k),clsHSS.EstrattoFrequenzaTxt(k,Ini,fin),_
      clsHSS.EstrattoRitardoTxt(k,Ini,fin))
      If aValori(02) > 00 And aValori(02) <= 03 Then
         Call AddRigaTabella(aValori,Magenta_,"right")
      ElseIf aValori(02) > 03 And aValori(02) <= 05 Then
         Call AddRigaTabella(aValori,Giallo_,"right")
      ElseIf aValori(02) > 05 And aValori(02) <= 08 Then
         Call AddRigaTabella(aValori,Verde_,"right")
      ElseIf aValori(02) > 08 Then
         Call AddRigaTabella(aValori,Rosso_,"right")
      End If
   Next
   Call CreaTabella(02) : Set clsHSS = Nothing
End Sub