EXCEL E DINTORNI

[solare]

Non sono Baciccia.
Il file da scaricare è questo: Vedi l'allegato 2314056
Al suo interno vi sono molti fogli. Abbiamo visto che diversi hanno avuto un inizio ma non sono mai stati portati alla loro naturale conclusione.
Probabilmente il Baciccia si era dimenticato di quellom che stava facendo. Purtroppo le capitava.
Noi non siamo esperti di lotto, chi ha messo mano sul file conosce Excel ma ha deciso di limitarsi a cercare gli errori più banali e di aggiungere qualche foglio seguendone lo stile. Purtroppo non dispone di molto tempo e, a volte, mi chiama spiegandomi cosa devo fare.
Peccato che il mio livello di conoscenza di Excel sia ben poca cosa. La prima volta che mi ha detto: "Apri la macro XY" le ho chiesto la chiave...

Grazieee

 

[Baciccia4251]

15.45 MB file on MEGA

mega.nz

Velocizzato il foglio Analisi quindicine1
In Archivio aggiunto il pulsante per creare un file TXT da usare in Spaziometria (con l'apposita macro) per aggiornare l'archivio
(se vi serve lo usate, se non vi serve non lo usate, se non funziona fatelo presente. Non sono interessato a commenti non richiesti d'altro genere).

Lo Script per Spaziometria è questo:

'Aggiorna archivio lotto di Spaziometria (Ramco)_apr2026
'Versione modificata per usare storico.txt generato da Excel

Option Explicit
Sub Main

Dim sDirTemp,sFileBd
Dim sCData,nSalvate
Dim sDataEstr,sDataLastEstr
Dim nEstrTot,id,z,b
Dim aRighe,k
Dim sData,sSigla
Dim aEstr,r,c
Dim aCampi

sFileBd = GetDirectoryAppData & "BaseDati.dat"

' --- Percorso file TXT ---
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

' 2 = cartella TEMP di Windows
sDirTemp = fso.GetSpecialFolder(2) & "\storico.txt"

' --- Verifica esistenza file TXT ---
If Not fso.FileExists(sDirTemp) Then
Call Scrivi("ERRORE: il file storico.txt non esiste.",True,,,vbRed)
Call Scrivi("Generarlo prima da Excel con la macro CreaStoricoTXT.",True)
Set fso = Nothing
Exit Sub
End If

Set fso = Nothing

' --- Lettura righe del file TXT ---
ReDim aRighe(0)
If Not LeggiRigheFileDiTesto(sDirTemp,aRighe) Then
Call Scrivi("ERRORE: impossibile leggere storico.txt.",True,,,vbRed)
Exit Sub
End If

' --- Dati archivio corrente ---
nEstrTot = EstrazioniArchivio
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
z = Right(sDataLastEstr,4) & "/" & Mid(sDataLastEstr,4,2) & "/" & Left(sDataLastEstr,2)
id = IndiceAnnuale(nEstrTot)
b = False

' --- Loop sulle righe del file TXT ---
ReDim aEstr(11,5)
sCData = ""

For k = 0 To UBound(aRighe)
If ScriptInterrotto Then Exit For

If Trim(aRighe(k)) <> "" Then

aCampi = Split(aRighe(k),vbTab)

If UBound(aCampi) >= 6 Then
sData = Trim(aCampi(0)) ' AAAA/MM/GG
sSigla = Trim(aCampi(1))

' --- Nuova data ---
If sData <> sCData Then

If b = True Then
If sCData <> "" Then
If Left(sCData,4) <> Left(sData,4) Then id = 0
id = id + 1
sDataEstr = Right(sCData,2) & "/" & Mid(sCData,6,2) & "/" & Left(sCData,4)
If SalvaEstrazione(aEstr,sDataEstr,id,sFileBd) Then
nSalvate = nSalvate + 1
Call Messaggio(nSalvate)
Else
ColoreTesto 2
Call Scrivi("ATTENZIONE: errore salvataggio estrazione " & sCData,True)
ColoreTesto 0
End If
End If
End If

If sCData = z Then b = True

ReDim aEstr(11,5)
sCData = sData
End If

' --- Rimappatura sigle ---
If sSigla = "BA" Then r = 1
If sSigla = "CA" Then r = 2
If sSigla = "FI" Then r = 3
If sSigla = "GE" Then r = 4
If sSigla = "MI" Then r = 5
If sSigla = "NA" Then r = 6
If sSigla = "PA" Then r = 7
If sSigla = "RM" Then r = 8
If sSigla = "TO" Then r = 9
If sSigla = "VE" Then r = 10
If sSigla = "RN" Then r = 11

' --- Numeri ---
For c = 1 To 5
aEstr(r,c) = Format2(CInt(Trim(aCampi(c + 1))))
Next

End If
End If

Call AvanzamentoElab(0,UBound(aRighe),k)
Next

' --- Salva ultima estrazione ---
If b = True Then
If sCData <> "" Then
id = id + 1
sDataEstr = Right(sCData,2) & "/" & Mid(sCData,6,2) & "/" & Left(sCData,4)
If SalvaEstrazione(aEstr,sDataEstr,id,sFileBd) Then
nSalvate = nSalvate + 1
End If
End If
End If

' --- Riepilogo ---
If nSalvate > 0 Then
AllineaArchivi
Call Scrivi()
Call Scrivi("Script per Spaziometria - Aggiornamento da file Excel",True,,,vbBlue)
Call Scrivi()
Call Scrivi("Sono state aggiunte " & nSalvate & " estrazioni")
Call Scrivi()
Call Scrivi("Estrazioni totali: " & EstrazioniArchivio)
Call Scrivi()
Call Scrivi("RAMCOLOTTO",True,,,vbBlue)
Else
Call Scrivi("NON HO TROVATO NUOVE ESTRAZIONI !",1,,,2)
End If

End Sub