Modificare file CSV

Anonimo

Buon pomeriggio a tutti,

Avrei urgente bisogno di un vostro aiuto a capire se si può fare ed ovviamente come fare a modificare dei file CSV.

Praticamente ho dei dati scaricati da una centrale idroelettrica in CSV.

sono dei dati giornalieri, pertanto oltre ad essere il file stesso molto grande è anche moltiplicato per 360 giorni.

Per questo motivo, vorrei sapere se possibile creare una macro ove mi apre i file uno ad uno e mi incrementa un valore (quantità acqua) di un icremento random tra 5 e 20.

Allego una piccola parte del file CSV:

,"16/01/21","20:13:31"," 559"," 143"
,"16/01/21","21:13:31"," 557"," 142"
,"16/01/21","22:13:31"," 556"," 142"
,"16/01/21","23:13:31"," 556"," 142"
,"17/01/21","00:13:31"," 558"," 143"
,"17/01/21","01:13:31"," 560"," 143"
,"17/01/21","02:13:31"," 540"," 138"
,"17/01/21","03:13:31"," 558"," 143"
,"17/01/21","04:13:31"," 561"," 143"
,"17/01/21","05:13:31"," 556"," 142"
,"17/01/21","06:13:31"," 554"," 142"
,"17/01/21","07:13:31"," 555"," 142"
,"17/01/21","08:13:31"," 556"," 142"
,"17/01/21","09:13:31"," 558"," 143"
,"17/01/21","10:13:31"," 553"," 142"
,"17/01/21","11:13:31"," 555"," 142"
,"17/01/21","12:13:31"," 556"," 142"
,"17/01/21","13:13:31"," 557"," 142"
,"17/01/21","14:13:31"," 557"," 142"

Come si vede dal file CSV, la prima colonna è la data, poi l'ora della misurazione, la quantità d'acqua passata sotto al lettore in quel preciso momento espressa in litri e poi l'altezza del galleggiante.

Condierando che un solo file CSV è di 1440 righe e dovrei modificare questi valori per 1440 volte e poi per 365 giorni dell'anno potrei arrivare a Natale e non aver ancora finito.

Ricapitolando mi servirebbe una macro che in automatico apre il file modifica random il valore dell'acqua incrementandolo di una quantità random compresa tra 5 e 20 salva il file e fa lo stesso lavoro al file successivo fino ad arrivare all'ultimo file.

Spero si possa fare, confido nei vostri aiuti.

Grazie e saluti

Giuseppe

Ecco il link ove sono i file CSV: https://1drv.ms/u/s!AnKwumX30imegaQHpUrLqrewmn-igQ?e=6afpfZ

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

Ciao Giuseppe,

in effetti nella cartella condivisa esistevano dei file excel che non erano CSV originali.

A me va benissimo il codice come creato.

Ti condivido la cartella originale ove faccio i test ed il frimo foglio me lo crea bianco pur essendo un file CSV.

Per il resto è tutto più che perfetto.

Se hai tempo, dai un occhio a questa cartella che sicuramente saprai dirmi perchè il primo file lo crea vuoto.

https://1drv.ms/u/s!AnKwumX30imegbtcfTj4a41NBYsgFg?e=37wj9u

Se uno dei 356 file csv originariamente viene aperto in Excel utilizzando VBA, i dati vengono automaticamente suddivisi in colonne separate. Al contrario, se i 3 file csv appena caricati vengono aperti da VBA, i dati non vengono suddivisi ma, invece, visualizzati in un'unica colonna. Si deve concludere che i 3 file appena caricati sono stati creati in modo diverso dai precedenti 356 file.

Poiché il mio codice utilizza i dati nelle colonne B:E e i dati del file SA00000_01_03_2021.csv sono tutti visualizzati nella colonna A, nessun dato separato da virgole viene passato alla procedura ConvertireSeparatorePerCSV e, di conseguenza, viene salvato un file csv vuoto nella

directory Monte.

Tuttavia, ho rivisto il codice per gestire la possibilità che i file csv originali possano aprirsi in modalità divisa o non divisa. Eseguendo il codice rivisto, tutti i 359 file csv originali vengono gestiti correttamente e tutti i file csv archiviati nella directory Monte contengono i dati previsti.

Nel seguente codice aggiornato, le modifiche sono evidenziate in rosso:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim oFSO As Object 

Dim oFolder As Object 

Dim oFile As Object 

Dim WB  As Workbook 

Dim SH As Worksheet 

Dim Rng As Range, Rng2 As Range 

Dim arrIn As Variant 

Dim sFolder\_Sorgente As String, sFolder\_Valle As String, sFolder\_Monte As String 

Dim sPercorso\_Monte As String, sPercorso\_Valle As String 

Dim sFileName As String 

Dim vOld As Long, vNew As Long 

Dim i As Long, iVal As Long 

Dim iCtr As Long 

Dim LRow As Long 

Dim bFlag As Boolean 

Const sPrefisso\_Monte As String = "Monte" 

Const sPrefisso\_Valle As String = "Valle" 

With Application.FileDialog(msoFileDialogFolderPicker) 

    .Title = "SELEZIONA LA DIRECTORY SORGENTE" 

    If .Show = -1 Then 

        sFolder\_Sorgente = .SelectedItems(1) 

    Else 

        Call MsgBox(Prompt:="Non hai selezionato una Directory SORGENTE!", \_ 

            Buttons:=vbCritical, \_ 

            Title:="ERRORE!") 

        Exit Sub 

    End If 

End With 

sPercorso\_Monte = sFolder\_Sorgente & "\" & sPrefisso\_Monte 

sPercorso\_Valle = sFolder\_Sorgente & "\" & sPrefisso\_Valle 

Set oFSO = CreateObject("Scripting.FileSystemObject") 

If Not oFSO.FolderExists(sPercorso\_Monte) Then 

    oFSO.CreateFolder sPercorso\_Monte 

End If 

If Not oFSO.FolderExists(sPercorso\_Valle) Then 

    oFSO.CreateFolder sFolder\_Sorgente & "\" & sPrefisso\_Valle 

End If 

Set oFolder = oFSO.GetFolder(sFolder\_Sorgente) 

On Error GoTo XIT 

Application.ScreenUpdating = False 

For Each oFile In oFolder.Files 

    If Right(oFile.Name, 3) = "csv" Then 

        FileCopy oFile.path, sPercorso\_Valle & "\" & sPrefisso\_Valle & oFile.Name 

        Set WB = Workbooks.Open(oFile) 

        ThisWorkbook.Sheets(1).Cells(iCtr + 1, 1).Value = oFile.Name 

        Set SH = WB.Sheets(1) 

        With SH 

            **If .UsedRange.Columns.Count = 1 Then** 

                **Call TextToCol(.UsedRange)** 

            **End If** 

            LRow = LastRow(SH) 

            Set Rng = .Range("B2:E" & LRow) 

            .Range("A1").Value = "xxx" 

            Set Rng2 = .UsedRange 

            .Range("A1").ClearContents 

        End With 

        arrIn = Rng.Value 

        For i = 1 To UBound(arrIn) 

            If TypeName(arrIn(i, 1)) = "String" Then 

                '\\Tutto bene, Excel non ha convertito questo dato in una data 

            ElseIf TypeName(arrIn(i, 1)) = "Date" Then 

                '\\ Excel avrebbe potuto erroneomente interpretato questo dato come una data in formato americano mm/gg/aaaa 

                '\\Quindi: 

                If Month(arrIn(i, 1)) &lt;= 12 Then 

                    arrIn(i, 1) = Format(arrIn(i, 1), "mm/dd/yyyy") 

                End If 

            End If 

            arrIn(i, 2) = CStr(Format(arrIn(i, 2), "hh:mm:ss")) 

            If arrIn(i, 3) &lt;&gt; 0 Then 

                vOld = arrIn(i, 3) 

                arrIn(i, 3) = arrIn(i, 3) + Int((20 - 5 + 1) \* Rnd + 5) 

                vNew = arrIn(i, 3) 

                arrIn(i, 4) = CLng(arrIn(i, 4) \* vNew / vOld) 

            End If 

        Next i 

        Rng.NumberFormat = "@" 

        Rng.Value = arrIn 

        sFileName = sPercorso\_Monte & "\" & sPrefisso\_Monte & oFile.Name 

        Call ConvertireSeparatorePerCSV(Rng2, sFileName) 

        WB.Close SaveChanges:=False 

        iCtr = iCtr + 1 

    End If 

Next oFile 

Call MsgBox(Prompt:="Finito!" & vbNewLine & iCtr & " File sono stati aggiornati", Buttons:=vbInformation, Title:="REPORT!")

XIT:

Application.ScreenUpdating = True 

Set oFile = Nothing 

Set oFolder = Nothing 

Set oFSO = Nothing

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

Optional Rng As Range, \_ 

Optional minRow As Long = 1) 

If Rng Is Nothing Then 

    Set Rng = SH.Cells 

End If 

On Error Resume Next 

LastRow = Rng.Find(What:="\*", \_ 

    After:=Rng.Cells(1), \_ 

    Lookat:=xlPart, \_ 

    LookIn:=xlFormulas, \_ 

    SearchOrder:=xlByRows, \_ 

    SearchDirection:=xlPrevious, \_ 

    MatchCase:=False).Row 

On Error GoTo 0 

If LastRow &lt; minRow Then 

    LastRow = minRow 

End If

End Function

'--------->>

Public Sub ConvertireSeparatorePerCSV(Rng As Range, sFullFileName As String)

Dim srcRng As Range 

Dim rRow As Range 

Dim rCell As Range 

Dim sStr As String 

Dim FName As Variant 

Dim i As Long, j As Long 

Const sSeparatoreVoluto As String = "," 

Application.DisplayAlerts = False 

    Open sFullFileName For Output As #1 

    For Each rRow In Rng.Rows 

        sStr = "" 

        For Each rCell In rRow.Cells 

            If rCell.Column() = 1 Then 

            sStr = sStr & " " & sSeparatoreVoluto 

        Else 

            sStr = sStr & """" & rCell.Value & """" & sSeparatoreVoluto 

        End If 

        Next rCell 

        While Right(sStr, 1) = sSeparatoreVoluto 

            sStr = Left(sStr, Len(sStr) - 1) 

        Wend 

        Print #1, sStr 

    Next 

    Close #1 

Application.DisplayAlerts = True

End Sub

'--------->>

Public Sub TextToCol(rCol As Range)

  **rCol.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, \_** 

    **TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, \_** 

    **Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo \_** 

    **:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), \_** 

    **TrailingMinusNumbers:=True**

End Sub

'<<=========

Potresti scaricare il mio file aggiornato Giuseppe20220227.xlsm

===

Regards,

Norman

0 commenti

15 risposte aggiuntive

Anonimo

2022-02-27T07:07:21+00:00

Buongiorno Norman e tutti,

innanzitutto grazie per il codice che come al solito siete sempre fantastici.

Norman, come mai sul "underscore" mi dice carattere non valido e parte del codice va in errore?

Inoltre volevo scaricare il tuo file ma non funziona.

Grazie ancora e buona giornata

Giuseppe
La risposta è stata utile?

0 commenti Nessun commento

Anonimo

Ciao Giuseppe,

Se vorresti mantenere inalterati i file csv originali e creare nuovi file csv (o, eventualmente, file xlsx), rinominando i nuovi file con il prefisso Updated_ , potresti sostituire il codice con qualcosa del genere:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim oFSO As Object 

Dim oFolder As Object 

Dim oFile As Object 

Dim WB  As Workbook 

Dim SH As Worksheet 

Dim Rng As Range 

Dim arrIn As Variant 

Dim sFolder As String 

Dim i As Long, iVal As Long 

Dim iCtr As Long 

Dim LRow As Long 

Const sPrefisso As String = "Updated\_" 

With Application.FileDialog(msoFileDialogFolderPicker) 

    .Title = "SELEZIONA UNA DIRECTORY" 

    If .Show = -1 Then 

        sFolder = .SelectedItems(1) 

    Else 

        Call MsgBox(Prompt:="Non hai selezionato una Directory!", \_ 

            Buttons:=vbCritical, \_ 

            Title:="ERRORE!") 

        Exit Sub 

    End If 

End With 

Set oFSO = CreateObject("Scripting.FileSystemObject") 

Set oFolder = oFSO.GetFolder(sFolder) 

On Error GoTo XIT 

Application.ScreenUpdating = False 

For Each oFile In oFolder.Files 

    If Right(oFile.Name, 3) = "csv" Then 

        If Not oFile.Name Like sPrefisso & "\*" Then 

            Set WB = Workbooks.Open(ofile) 

            Set SH = WB.Sheets(1) 

            With SH 

                LRow = LastRow(SH) 

                Set Rng = .Range("D2:D" & LRow) 

            End With 

            arrIn = Rng.Value 

             For i = 1 To UBound(arrIn) 

                arrIn(i, 1) = arrIn(i, 1) + Int((20 - 5 + 1) \* Rnd + 5) 

            Next i 

            Rng.Value = arrIn 

            WB.SaveAs WB.Path & "\" & sPrefisso & WB.Name 

            WB.Close SaveChanges:=False 

            iCtr = iCtr + 1 

        End If 

    End If 

Next oFile 

Call MsgBox(Prompt:="Finito!" & vbNewLine & iCtr & " File sono stati aggiornati", Buttons:=vbInformation, Title:="REPORT!")

XIT:

Application.ScreenUpdating = True 

Set oFile = Nothing 

Set oFolder = Nothing 

Set oFSO = Nothing

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

Optional Rng As Range, \_ 

Optional minRow As Long = 1) 

If Rng Is Nothing Then 

    Set Rng = SH.Cells 

End If 

On Error Resume Next 

LastRow = Rng.Find(What:="\*", \_ 

    After:=Rng.Cells(1), \_ 

    Lookat:=xlPart, \_ 

    LookIn:=xlFormulas, \_ 

    SearchOrder:=xlByRows, \_ 

    SearchDirection:=xlPrevious, \_ 

    MatchCase:=False).Row 

On Error GoTo 0 

If LastRow &lt; minRow Then 

    LastRow = minRow 

End If

End Function

'<<========

Potresti scaricare il mio file di prova Giuseppe20220226.xlsm

===

Regards,

Norman

0 commenti

Anonimo

Ciao Giuseppe,

Avrei urgente bisogno di un vostro aiuto a capire se si può fare ed ovviamente come fare a modificare dei file CSV.

Praticamente ho dei dati scaricati da una centrale idroelettrica in CSV.

sono dei dati giornalieri, pertanto oltre ad essere il file stesso molto grande è anche moltiplicato per 360 giorni.

Per questo motivo, vorrei sapere se possibile creare una macro ove mi apre i file uno ad uno e mi incrementa un valore (quantità acqua) di un icremento random tra 5 e 20.

Allego una piccola parte del file CSV:

,"16/01/21","20:13:31"," 559"," 143"

,"16/01/21","21:13:31"," 557"," 142"

,"16/01/21","22:13:31"," 556"," 142"

,"16/01/21","23:13:31"," 556"," 142"

,"17/01/21","00:13:31"," 558"," 143"

,"17/01/21","01:13:31"," 560"," 143"

,"17/01/21","02:13:31"," 540"," 138"

,"17/01/21","03:13:31"," 558"," 143"

,"17/01/21","04:13:31"," 561"," 143"

,"17/01/21","05:13:31"," 556"," 142"

,"17/01/21","06:13:31"," 554"," 142"

,"17/01/21","07:13:31"," 555"," 142"

,"17/01/21","08:13:31"," 556"," 142"

,"17/01/21","09:13:31"," 558"," 143"

,"17/01/21","10:13:31"," 553"," 142"

,"17/01/21","11:13:31"," 555"," 142"

,"17/01/21","12:13:31"," 556"," 142"

,"17/01/21","13:13:31"," 557"," 142"

,"17/01/21","14:13:31"," 557"," 142"

Come si vede dal file CSV, la prima colonna è la data, poi l'ora della misurazione, la quantità d'acqua passata sotto al lettore in quel preciso momento espressa in litri e poi l'altezza del galleggiante.

Condierando che un solo file CSV è di 1440 righe e dovrei modificare questi valori per 1440 volte e poi per 365 giorni dell'anno potrei arrivare a Natale e non aver ancora finito.

Ricapitolando mi servirebbe una macro che in automatico apre il file modifica random il valore dell'acqua incrementandolo di una quantità random compresa tra 5 e 20 salva il file e fa lo stesso lavoro al file successivo fino ad arrivare all'ultimo file.

Ecco il link ove sono i file CSV: https://1drv.ms/u/s!AnKwumX30imegaQHpUrLqrewmn-igQ?e=6afpfZ

Prova qualcosa del genere:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim oFSO As Object 

Dim oFolder As Object 

Dim ofile As Object 

Dim WB  As Workbook 

Dim SH As Worksheet 

Dim Rng As Range 

Dim arrIn As Variant 

Dim sFolder As String

Dim i As Long 

Dim iCtr As Long 

Dim LRow As Long 

With Application.FileDialog(msoFileDialogFolderPicker) 

     .Title = "Seleziona una directory" 

    If .Show = -1 Then 

        sFolder = .SelectedItems(1) 

    Else 

        Call MsgBox(Prompt:="Non hai selezionato una Directory!", \_ 

            Buttons:=vbCritical, \_ 

            Title:="ERRORE!") 

        Exit Sub 

    End If 

End With 

Set oFSO = CreateObject("Scripting.FileSystemObject") 

Set oFolder = oFSO.GetFolder(sFolder) 

On Error GoTo XIT 

Application.ScreenUpdating = False 

For Each ofile In oFolder.Files 

    If Right(ofile.Name, 3) = "csv" Then 

        Set WB = Workbooks.Open(ofile) 

        Set SH = WB.Sheets(1) 

        With SH 

            LRow = LastRow(SH) 

            Set Rng = .Range("D2:D" & LRow) 

        End With 

        arrIn = Rng.Value 

        For i = 1 To UBound(arrIn) 

            arrIn(i, 1) = arrIn(i, 1) + Int((20 - 5 + 1) \* Rnd + 5) 

        Next i 

        Rng.Value = arrIn 

        WB.Close SaveChanges:=True 

        iCtr = iCtr + 1 

    End If 

Next ofile 

Call MsgBox(Prompt:="Finito!" & vbNewLine & iCtr & " File sono stati aggiornati", Buttons:=vbInformation, Title:="REPORT!")

XIT:

Application.ScreenUpdating = True

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

Optional Rng As Range, \_ 

Optional minRow As Long = 1) 

If Rng Is Nothing Then 

    Set Rng = SH.Cells 

End If 

On Error Resume Next 

LastRow = Rng.Find(What:="\*", \_ 

    After:=Rng.Cells(1), \_ 

    Lookat:=xlPart, \_ 

    LookIn:=xlFormulas, \_ 

    SearchOrder:=xlByRows, \_ 

    SearchDirection:=xlPrevious, \_ 

    MatchCase:=False).Row 

On Error GoTo 0 

If LastRow &lt; minRow Then 

    LastRow = minRow 

End If

End Function

'<<========

===

Regards,

Norman

0 commenti

Anonimo

2022-02-26T16:36:49+00:00

Ciao Giuseppe,

qui Daniele, bentrovato nella community Microsoft,

i primi tre file sono il formato xlsx perché hai provato a modificarli?

All'apertura il file CSV non si presenta su tre colonne ma i dati sono solo nella prima, non è un problema ma vorrei sapere se è sempre così oppure può variare
La risposta è stata utile?

0 commenti Nessun commento