Importa e accoda dati separati da files csv

[BG66]

Buon 1° Maggio ( mi porto avanti ) a tutti.

Partendo da questo thread (Anthony docet ): http://www.pc-facile.com/forum/viewtopic.php?f=26&t=110517
con la sola modifica dell'estensione:

Codice: Seleziona tutto

Sub Unisci()
Dim MyPath As String
Dim MyName As String
Dim iRow As Long
Dim iCount As Long
Dim wbOrig As Workbook
Dim shOrig As Worksheet
Dim wbDest As Workbook
Dim shDest As Worksheet
Dim xRow As Long
Dim iCol As Integer

Application.ScreenUpdating = False
Set wbDest = ThisWorkbook
Set shDest = wbDest.Sheets("RIEPILOGO")

MyPath = ThisWorkbook.Path & "\"    ' Imposta il percorso.
MyName = Dir(MyPath & "*.csv", vbNormal)   ' Recupera la prima voce.
Do While MyName <> ""    ' Avvia il ciclo.
    If MyName <> wbDest.Name Then 'esclude se stesso
        Set wbOrig = Workbooks.Open(MyPath & MyName)
        Set shOrig = wbOrig.Sheets(1) '<=== da verificare

        With shDest

            iRow = .Range("a" & Rows.Count).End(xlUp).Row + 1 'determina la prima riga vuota del foglio Destinazione
           
            iCount = shOrig.Range("a" & shOrig.Rows.Count).End(xlUp).Row ' determina l'ultima riga piena del foglio Origine
   
            For xRow = 2 To iCount 'avvia il ciclo righe
                For iCol = 1 To 10 ' avvia ciclo colonne
                    .Cells(iRow, iCol) = shOrig.Cells(xRow, iCol) 'scrive valori
                    '.Cells(iRow, 1).Resize(iCount, 10).Value = shOrig.Cells(2, 1).Resize(iCount, 10).Value
                Next
                iRow = iRow + 1
            Next
           
            wbOrig.Close False 'chiude il foglio Origine
        End With
    End If

    MyName = Dir    ' Legge la voce successiva.
Loop

Application.ScreenUpdating = True

Set wbDest = Nothing
Set shDest = Nothing
Set wbOrig = Nothing
Set shOrig = Nothing

End Sub


Ottengo l'importazione e l'accodamento dei dati da vari files csv presenti in cartella ma, purtroppo tutti su unica riga.
Cosa bisogna modificare per suddividerli correttamente (in pratica ad ognuno la sua colonna)?
Ora è cosi:


Vorrei questo ( possibilmente importando le intestazioni una sola volta ed evitando le celle contenenti solamente punti e virgole)


File riepilogo: https://www.dropbox.com/s/w2f2pe384d72v4s/RIEPILOGO_Anthony.xlsm?dl=0
Esempi di files csv ("in dotazione"): https://www.dropbox.com/s/axzeoh7jb32a8ne/ELEDIP%20%2812%29.csv?dl=0
https://www.dropbox.com/s/vjywvvn8iclbo3x/ELEDIP%20%2811%29.csv?dl=0

Grazie per l'aiuto.
Gene

[Marius44]

Ciao Gene
Premetto che non ho scaricato il files.

Secondo me hai due strade:

a) incrementare ad ogni ciclo iCol; voglio dire, in questa riga di codice
.Cells(iRow, iCol) = shOrig.Cells(xRow, iCol) 'scrive valori
la prima iCol si deve incrementare di una unità ad ogni passaggio (ma non mi sembra la cosa migliore)

b) dopo aver importato i dati, esegui (magari poi lo passi con VBA) un TESTO IN COLONNE con delimitatore il " ; "

Spero di non incorrere negli "strali" del Moderatore (ciao Anthony)
Ciao,
Mario

[Anthony47]

Mario, le tue raccomandazioni vanno bene in linea generale; nel caso specifico quella utilizzabile e' la "B" (dati in colonna). E comunque non abbiamo "strali" a magazzino (non dico che "mi sono appena finiti", ma proprio non abbiamo l'articolo).

Ma la mia raccomandazione e' di NON "Aprire" i file csv ma piuttosto "Importarli". Questa scelta nasce dal fatto che Excel a volte prende troppe iniziative e fa in proprio delle conversioni ragionevoli ma non prevedibili.
Ad esempio Aprire un file csv spesso comporta il suo incolonnamento, cioe' il "Dati in Colonna" viene fatto automaticamente. "Spesso", ma non "Sempre".

Cio' detto, la macro suggerita diventa:

Codice: Seleziona tutto

Sub Unisci2()
Dim MyPath As String
Dim MyName As String
'Dim iRow As Long
'Dim iCount As Long
'Dim wbOrig As Workbook
'Dim shOrig As Worksheet
'Dim wbDest As Workbook
Dim shDest As Worksheet
Dim xRow As Long
'Dim iCol As Integer
'
''Application.ScreenUpdating = False
''Set wbDest = ThisWorkbook
Set shDest = ThisWorkbook.Sheets("RIEPILOGO_2")      '<<< Il Foglio di Importazione


MyPath = ThisWorkbook.Path & "\"    ' Imposta il percorso.
MyName = Dir(MyPath & "*.csv", vbNormal)   ' Recupera la prima voce.
Do While MyName <> ""    ' Avvia il ciclo.
    xRow = shDest.Cells(Rows.Count, 1).End(xlUp).Row + 1
    If xRow = 2 Then xRow = 1
    Call Cancella_Connections(shDest)
    With shDest.QueryTables.Add(Connection:= _
        "TEXT;" & MyPath & MyName, Destination:=shDest.Cells(xRow, 1))   'Range("$A$1"))
        .Name = "CCSV"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850   'xlWindows     '
        If xRow = 1 Then
            .TextFileStartRow = 1
        Else
            .TextFileStartRow = 2
        End If
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 4, 4, 1, 1, 1, 1, 4, 4, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    MyName = Dir    ' Legge la voce successiva.
Loop
Application.ScreenUpdating = True
''Set wbDest = Nothing
Set shDest = Nothing
''Set wbOrig = Nothing
''Set shOrig = Nothing
End Sub


Sub Cancella_Connections(ByRef mySh As Worksheet)
Dim myTim As Single
myTim = Timer
On Error Resume Next
Do While mySh.QueryTables.Count > 0
    mySh.QueryTables(1).Delete
    If Timer > (myTim + 3) Then Exit Do
Loop
On Error GoTo 0
End Sub


Ho "commentato" alcune definizioni e istruzioni inutili; possono essere cancellate.

Noterai un "850??"; 850 e' il valore che mi ha inserito il registratore di macro; ma la documentazione della XlPlatform enumeration (https://docs.microsoft.com/en-us/office ... lplatform) cita come valori ammissibili 1-2-3; io ho usato nei test xlWindows=2 e ha funzionato. Pero' ha funzionato anche con 850=boh?
Se mai dovessi avere dei problemi prova a sostituire xlWindows con 850...

La macro si appoggia su una Sub Cancella_Connections, che serve a eliminare TUTTE le QueryTables presenti sul foglio di riepilogo ed evitarne la proliferazione incontrollata (credo che ci sia un limite di 1000 connessioni; avrei anche potuto lasciate la Query e modificarne la proprieta' Connection, ma questa prestazione non e' disponibile in tutte le versioni circolanti di Excel, per cui ho ripiegato sul drastico Cancella)

Fai sapere...

[Marius44]

Ciao Anthony

LECTIO MAGISTRALIS

Grazie e ciao,
Mario

[BG66]

[RISOLTO]
Grazie Anthony. E' spettacolare!

PS Nessuna modifica è stata necessaria.

Alla prossima
Gene

[klingklang]

Solo a titolo di "partecipazione", visto che conosci già il mio programma (Excel Swiss Knife), segnalo che avresti potuto usare anche lo strumento Importa/Esporta -> Importa file di testo multipli
Ciao a tutti

[BG66]

Ciao Enrico,
francamente è quello che ho fatto fino ad ieri.
Ma nel cambiare l'operatore/ pc ho dovuto giocoforza tenere conto della policy aziendale e rendere "autonomo" il file.

Ne approfitto per chiederti se la funzione CERCA DOPPIONE e cancella l'intera riga esiste in ESK?

Grazie se puoi.
Gene

[klingklang]

Hai pvt