ho un problema da risolvere.
Ho scritto un codice VBA per importare dei file .txt in excel. Fin qui, tutto bene. Su questi dati importati svolgo dei calcoli ma non capisco come mai alcuni valori vengono presi da excel come date anzichè come ore.
Il problema non si presenta sempre ma solo con valori di ore che "assomigliano a date".
Ad esempio:
16.10.53 viene letto come 16/10/1953. Non serve dire che tutti i calcoli vengono sbagliati, essendo un formato dierso.
Allego il codice VBA (commentato operazione per operazione, come da mia prassi) ed un file "incriminato":
GRAZIE A CHI SAPRA' AIUTARMI!!
Giulio
File incriminato:
https://rapidshare.com/files/994060524/6.txt
(si noti che nella colonna dei tempi chiamata TIME vi è una serie di orari che vengono importati male).
CODICE VBA:
- Codice: Seleziona tutto
Sub Importa_TXT()
'----COSA FA LA MACRO
'----la macro importa dei file di testo con estensione .txt che contengono
'----le misurazioni di campi elettromagnetici e assegna ad ogni file di
'----di testo un foglio specifico avente lo stesso nome.
Dim i, n As Integer
Sheets("Dati_CEM").Select
'----seleziono la cella contenente la quantità di files .txt da processare
i = Cells(5, 3).Value
'----creo un ciclo FOR per creare tanti fogli quanti sono i file .txt da importare
'----nello stesso ciclo importo il file .txt
Dim z As Integer
z = 11
For n = 1 To i
'----aggiungo un nuovo foglio
ActiveWorkbook.Worksheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = n
Dim percorso As String
Dim nome_file As String
Dim ENNE As String
ENNE = n
'---Per semplicità i fogli sono tutti numerati nella cartella
'---d'origine come: "cifra.txt"
'---Inserisco le stringhe che contengono il percorso ed il
'---nome file che cambierà essendo legato all'integer n
percorso = "\\Dati\dati\_COMUNE\CEM\MACRO\DATA\"
nome_file = percorso & n & ".txt"
'----------------------------------importo i files
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & nome_file, Destination:=Range _
("$A$1"))
.Name = ENNE
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 4, 1, 1, 1, 1, 1, 1, 1)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = " "
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
'-------------------------------------------------ROUTINE PER ESECUZIONI CALCOLI SU OGNI FOGLIO!
Dim w As Integer
Dim x, y As Integer
'mi sposto in A1
Range("A1").Select
'cerco la cella che contiene il valore DATE (sempre adiacente alla casella TIME)
Cells.Find(What:="DATE", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
'eseguo un offset di una colonna a dx per posizionarmi sulla colonna giusta
ActiveCell.Offset(columnoffset:=1).Activate
'eseguo un offset di una riga in basso per posizionarmi sulla riga giusta
ActiveCell.Offset(rowoffset:=1).Activate
'rilevo la posizione esatta della cella in cui sono capitato
x = ActiveCell.Row
y = ActiveCell.Column
'assegno all'intero w il valore di x per avere quindi il riferimento di partenza
w = x
'-----finchè la cella ha un valore diverso da zero il valore di w viene incrementato
While Cells(x, y).Value <> 0
ActiveCell.Offset(rowoffset:=1).Activate
x = x + 1
Wend
'------CALCOLI------------------------------|
'---1--calcolo il tempo (ultimo - primo)
Dim tempo As String
x = x - 1
Cells(x, y).NumberFormat = "h:mm:ss"
Cells(w, y).NumberFormat = "h:mm:ss"
Cells(2, 1).NumberFormat = "h:mm:ss"
Cells(2, 1).Value = Cells(x, y).Value - Cells(w, y).Value
tempo = Cells(2, 1).Value
'--2---calcolo media
Dim media As String
'prima di tutto mi posiziono sulla cella di inizio valori
'la cella esatta si trova shiftata di due colonne
'è sufficiente incrementare quindi il valore di y
'per posizionarsi correttamente
y = y + 2
Cells(w, y).Select
'devo definire l'intervallo su cui lavorare che sarà
'la differenza fra x e w
k = x - w
Set zona = Range(Cells(w, y), Cells(w, y).End(xlDown))
Cells(w, y).End(xlDown).Select
Cells(2, 2).Value = (WorksheetFunction.Sum(zona) / k)
Cells(2, 2).Select
'---diminuisco il numero dei decimali nella casella della media
Selection.NumberFormat = "0.000"
media = Cells(3, 1).Value
'---3--trovo il valore massimo dell'intervallo
Dim val_max As String
Cells(2, 3).Value = (WorksheetFunction.Max(zona))
val_max = Cells(2, 3)
Range("A2:C2").Select
Selection.Copy
'-----mi sposto sul foglio Dati_CEM e scrivo i valori delle stringhe
Sheets("Dati_CEM").Select
Cells(z, 5).Value = ENNE
Cells(z, 6).Select
ActiveSheet.Paste
'disattivo la selezione della copia
Application.CutCopyMode = False
'Cells(z, 5).Value = ENNE
'Cells(z, 6).Select
'Cells(z, 6).NumberFormat = "h:mm:ss"
'Cells(z, 6).Value = tempo
'Cells(z, 7).Value = media
'Cells(z, 7).Select
'Selection.NumberFormat = "0.000"
'Cells(z, 8).Value = val_max
'-----------------------------------------------------------------------------------------------
End With
z = z + 1
Next
'----salvataggio del file ottenuto
Dim backup As String
Dim salva_come As String
Dim xls As String
Sheets("Dati_CEM").Select
salva_come = Cells(7, 3).Value
xls = ".xlsm"
backup = salva_come & xls
ActiveWorkbook.SaveAs Filename:= _
("\\Dati\dati\_COMUNE\CEM\MACRO\" & backup) _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub