Da file txt ad array multidim array object

Hai un problema con Excel?

Nuova discussione

Da file txt ad array multidim / array - object
di imparando (utente non iscritto) data: 18/11/2016 22:58:02
Ciao a tutti,

in VBA Excel devo aprire file .txt.
Per ognuno di questi file, dopo averlo sistemato (sostituzione di alcuni caratteri), vorrei dividerlo sia per righe (in base a vbcr) che per colonne (in base al punto e virgola .
I file sono molto grandi, quindi vorrei lavorare in memoria, e solo alla fine ho la necessità di scrivere la "tabella" sul foglio Excel.

Per capirci ogni file txt è del tipo:

aaa1; bbb1; ccc1
ddd1; eee1; fff1
aaa2; bbb2; ccc2
ddd2; eee2; fff2

dove a,b,c,d,e,f sono le caratteristiche di ciascun record, e 1 e 2 sono due diversi record

Girando in lungo e in largo su internet sono riuscito, col codice che posto sotto, a creare un array monodimensionale, del tipo:

aaa1; bbb1; ccc1; ddd1; eee1; fff1
aaa2; bbb2; ccc2; ddd2; eee2; fff2

Quello che vorrei ora è dividere ogni riga dell'array in diverse "colonne", ovvero ottenere un array bidimensionale, e poi alla fine scriverlo sul foglio di Excel.
Mentre con il codice che ho scritto finora mi scrive tutte le informazioni insieme nella prima colonna di ogni riga..

Mettendo insieme tutti i txt di origine si arriva nell'ordine di 80000, 100000 record finali, dunque occore qualcosa che vada anche veloce!

Spero di essere stato chiaro, e vi ringrazio tanto!

Qui il codice che ho adattato, ma qualora ci sia un modo migliore o più veloce, ben venga:

Sub Qantas_Delay_2()
Dim objFSO As Object
Dim objTF As Object
Dim strIn As String
Dim X
Dim Y

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTF = objFSO.OpenTextFile("C:UsersUtenteDesktopMyfile.txt", 1)
strIn = objTF.readall

'qui vado dapprima a mettere tutto su una riga, e poi rinvio a capo ogni nuovo record (in base ad un carattere)
Y = Replace(strIn, vbCr, "")
Y = Replace(Y, vbLf, ";")
Y = Replace(Y, "*", vbCr)

'qui sotto apporto delle modifiche ad alcuni caratteri
Y = Replace(Y, ",", ";")
Y = Replace(Y, "tizio =", "; tizio =")

X = Split(Y, vbCr)

[a1].Resize(UBound(X) + 1, 1) = Application.Transpose(X)

objTF.Close

End Sub

di patel data: 19/11/2016 08:12:27
io vorrei un piccolo file txt di esempio e un xlsx risultato desiderato
di imparando (utente non iscritto) data: 19/11/2016 17:15:10
Come posso fare per allegare file? In più non posso pubblicare, ma spiego chiaramente di seguito la situazione.

La situazione è esattamente questa:

-10 file txt, ognuno dei quali così composto:

*dato1a; dato1b; dato1c
dato1d; dato1e; dato1f
*dato2a; dato2b; dato2c
dato2d; dato2e; dato2f
(e così via per 3,4,5, ecc.)

Il risultato desiderato è quello di ottenere su uno sheet:

dato1a; dato1b; dato1c; dato1d; dato1e; dato1f
dato2a; dato2b; dato2c; dato2d; dato2e; dato2f
...ecc...
(ovvero il dato 1 sulla prima riga, il dato 2 sulla secondo riga, ecc, con i diversi attributi del dato a,b,c,d,e,f divisi per colonna)

Ora riesco ad ottenere quanto detto trattando ciascun txt con un editor esterno (in cui prima elimino spazi e ritorni a capo, dopodichè rimetto i ritorni a capo al posto del simbolo * - infatti da questo parte un nuovo dato) e poi facendo l'importazione testo da excel per ciascun file txt. Vorrei appunto evitare questo passaggio esterno.

I file txt sono abbastanza corposi.

Grazie mille per l'interesse
di patel data: 19/11/2016 18:59:13
accanto al pulsante Nuova Risposta c'è il pulsante Allega un File.
Ti ho parlato di piccolo file di ESEMPIO, non dell'originale, se tu vieni incontro a me io vengo incontro a te.
di imparando (utente non iscritto) data: 19/11/2016 19:16:56
ok, sono riuscito ad allegare i file.
Ci sono 10 txt come quelli che ho inviato.
Vorrei che tutti i dati in essi contenuti vengano scritti accodati su un unico foglio di Excel (come nell'immagine allegata).

Spero potete aiutarmi, grazie mille!
di patel data: 19/11/2016 20:28:24
avevo detto "io vorrei un piccolo file txt di esempio e un xlsx risultato desiderato "
No immagini, file excel con i dati corrispondenti al txt allegato
di imparando (utente non iscritto) data: 19/11/2016 22:35:31
Credevo fosse lo stesso, ho inserito il file txt, e nell'immagine c'è esattamente quello che vorrei ottenere in output.
Potresti darmi un aiuto perfavore?
di patel data: 20/11/2016 09:43:56
il file di testo allegato non corrisponde alla descrizione del primo post, io non ho voglia di perdere tempo.
di imparando (utente non iscritto) data: 20/11/2016 09:56:10
Non è perdere tempo, la situazione è esattamente come quella del file txt allegato. Forse mi ero espresso male nel post.
C'è qualcuno che gentilmente potrebbe darmi un aiuto? Grazie
di imparando (utente non iscritto) data: 20/11/2016 15:41:10
Ciao patel,

sono riuscito a caricare esattamente ciò che mi chiedevi.
Sono 10 file txt di input, e un Excel di output.
Vorrei, se possibile, che cliccando sul file Excel parta direttamente la macro che prelevi i dati dai txt e li metta nel foglio di Excel.
L'inizio di una nuova riga di dati è caratterizzata sempre dal carattere "*".

Grazie

di patel data: 20/11/2016 16:40:52
questa vale per un solo file, al resto ci pensi da te ?

Sub importa()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTF = objFSO.OpenTextFile("F:DownloadAinput_1.txt", 1)
strIn = objTF.readall
Y = Replace(strIn, "DATI" & vbCrLf, "")
Y = Replace(Y, vbCrLf, ";")
Y = Replace(Y, "*", vbCr)
Y = Replace(Y, ",", ";")
Y = Replace(Y, ";;", "")
Y = Replace(Y, "durata;", "durata")
Y = Right(Y, Len(Y) - 1)
X = Split(Y, vbCr)

[a1].Resize(UBound(X) + 1, 1) = Application.Transpose(X)

objTF.Close
Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Semicolon:=True

End Sub

di imparando (utente non iscritto) data: 20/11/2016 22:42:53
Grazie patel! Fin qui funziona benissimo

Se posso, ti faccio qualche altra domanda:

- se la prima riga non contiene sempre la stessa parola (DATI), come faccio a cancellarla sempre oppure far partire la scrittura su foglio dalla seconda riga?

- per quanto riguarda il secondo file, al fine di evitare di scrivere più volte la stessa istruzione (devo fare molti replace) posso inserire il codice da te scritto in un ciclo? Se sì, potresti indicarmi come? (non sono molto pratico con questi oggetti, che ho scoperto da pochissimo)
- Infine, e forse qui mi aggancio anche al punto precedente, io vorrei che copiando il file Excel in una cartella contenente tutti i txt e lanciando la macro, questa mi selezioni da sola alcuni dei file txt secondo il loro nome (ad esempio dei 10 txt prenda solo input_5 e input_8)?

Grazie infinite!

di patel data: 21/11/2016 08:13:33
se la riga DATI non è presente non ci sono problemi, il replace funziona solo se è presente
prova questa

Sub importa()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("F:downloadA") ' <<<< da modificare
R = 1
For Each objfile In objFolder.Files
  ext = LCase(Right(objfile.Name, 3))
  If ext = "txt" And (InStr(objfile.Name, "5") > 0 Or InStr(objfile.Name, "8") > 0) Then
    Set objTF = objFSO.OpenTextFile(objfile, 1)
    strIn = objTF.readall
    Y = Replace(strIn, "DATI" & vbCrLf, "")
    Y = Replace(Y, vbCrLf, ";")
    Y = Replace(Y, "*", vbCr)
    Y = Replace(Y, ",", ";")
    Y = Replace(Y, ";;", "")
    Y = Replace(Y, "durata;", "durata")
    Y = Right(Y, Len(Y) - 1)
    X = Split(Y, vbCr)
    Cells(R, 1).Resize(UBound(X) + 1, 1) = Application.Transpose(X)
    objTF.Close
  End If
  R = Cells(Rows.Count, "A").End(xlUp).Row + 1
Next
Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Semicolon:=True

End Sub

di imparando (utente non iscritto) data: 21/11/2016 12:13:21
Benissimo!! Ho testato ed è quasi quello che mi occorre!!

Ho fatto la modifica di spostare la riga
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
all'interno del blocco if, altrimenti mi shiftava di 1 nel caso non pescava al primo tentativo il file di input corretto (correggimi se sbaglio).

Per quanto riguarda il discorso della prima riga, invece, il fatto è che la riga è sempre presente ma non contiene sempre la stessa stringa (in realtà succede anche per l'ultima riga). Esiste modo di non prenderle in considerazione?
Pensavo tipo a cercare la prima relazione, e poi tagliare tutto quello che viene prima..

Ancora grazie!

di patel data: 21/11/2016 12:33:29
prova ora

Sub importa()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("F:downloadA") ' <<<< da modificare
R = 1
For Each objfile In objFolder.Files
  ext = LCase(Right(objfile.Name, 3))
  If ext = "txt" And (InStr(objfile.Name, "5") > 0 Or InStr(objfile.Name, "8") > 0) Then
    Set objTF = objFSO.OpenTextFile(objfile, 1)
    strIn = objTF.readall
    p = InStr(strIn, vbCrLf)
    Y = Right(strIn, Len(strIn) - p - 1)
    'Y = Replace(strIn, "DATI" & vbCrLf, "")
    Y = Replace(Y, vbCrLf, ";")
    Y = Replace(Y, "*", vbCr)
    Y = Replace(Y, ",", ";")
    Y = Replace(Y, ";;", "")
    Y = Replace(Y, "durata;", "durata")
    Y = Right(Y, Len(Y) - 1)
    X = Split(Y, vbCr)
    Cells(R, 1).Resize(UBound(X) + 1, 1) = Application.Transpose(X)
    objTF.Close
    R = Cells(Rows.Count, "A").End(xlUp).Row + 1
  End If
Next
Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Semicolon:=True

End Sub

di imparando (utente non iscritto) data: 21/11/2016 12:57:34
Spettacolo patel! Grazie!

In pratica cerchi la posizione del ritorno a capo, e dopo vai a prendere la parte destra della stringa, dico bene?

Per cancellare l'ultima riga invece, credo non si possa fare una cosa simile.. ?
Ad ogni modo, qualora non ci fossero modi per farlo, posso risolvere post-scrittura, andando a cancellare l'ultima riga inserita, oppure, dato che a volte l'informazione non voluta si trova nell'ultima colonna dell'ultima riga, andando a trovare questa cella e cancellandola.

Per quanto riguarda la dichiarazione delle variabili? In particolare quelle riferite agli oggetti obj?
Basta fare soltanto objtf.close per non accavallare i dati dei differenti txt?

Ancora grazie!
di patel data: 21/11/2016 15:40:31
In pratica cerchi la posizione del ritorno a capo, e dopo vai a prendere la parte destra della stringa, dico bene? ESATTO
Per cancellare l'ultima riga invece, credo non si possa fare una cosa simile.. ? NON E' SEMPRE UGUALE ?
Per quanto riguarda la dichiarazione delle variabili? NON E' NECESSARIA
In particolare quelle riferite agli oggetti obj? PRIMA DI End Sub SCRIVI Set objtf = Nothing
Basta fare soltanto objtf.close per non accavallare i dati dei differenti txt? objtf.close CHIUDE IL FILE TXT APERTO
di imparando (utente non iscritto) data: 21/11/2016 17:34:28
Grazie!!

Per l'ultima riga la vedo più difficile, perchè "cosa" vado a cercare con instr se l'ultima riga non è sempre la stessa?

"Set objtf = Nothing" non va all'interno del blocco if?

Se uno dei txt volessi aprirlo direttamente che istruzione devo utilizzare?
Mi spiego, con questo codice:

file_mo = Application.GetOpenFilename("Text Files (*.txt), *.txt")
With wsmo.QueryTables.Add(Connection:="TEXT;" & file_mo, Destination:=wsmo.Range("$A$1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

importo il file txt "file_mo" direttamente nel foglio, con l'utilizzo di una finestra per selezionarlo.
Supponendo che il nome del file contenga la dicitura "tizio", come faccio ad importarlo senza selezionarlo?

Grazie!!
di patel data: 22/11/2016 08:21:12
Per l'ultima riga la vedo più difficile ... se il num delle righe è costante basta eliminare l'ultima colonna a fine importazione

"Set objtf = Nothing" non va all'interno del blocco if? - basta in fondo

Supponendo che il nome del file contenga la dicitura "tizio", come faccio ad importarlo senza selezionarlo ? io utilizzere sempre la macro precedente con la modifica di questa riga
If ext = "txt" And InStr(objfile.Name, "tizio") > 0 Then
di imparando (utente non iscritto) data: 22/11/2016 08:29:28
Va benissimo così!
Solo per l'ultimo punto, siccome una volta importato secondo il metodo che ho postato, ho già una procedura che me lo elabora (perché il txt è differente dagli altri), non c'è un altro modo per cercarlo magari sempre con instr, e poi dirgli nell importazione testo prendi QUEL FILE individuato?

Grazie

di patel data: 22/11/2016 11:41:33
prova questa

Sub importaUno()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("F:DocumentiExcelfileMacro-VBACsvA") ' <<<< da modificare
For Each objfile In objFolder.Files
  ext = LCase(Right(objfile.Name, 3))
  If ext = "txt" And InStr(objfile.Name, "tizio") > 0 Then
  With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & objfile, Destination:=Range("$A$1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
  End If
Next

End Sub

di imparando (utente non iscritto) data: 22/11/2016 15:00:56
Ciao patel,
grazie mille.

Se non vado errato avrei risolto anche così, aggiungendo nel blocco if una ulteriore condizione:

ElseIf ext = "txt" And (InStr(objfile.Name, "tizio") > 0) Then
file_mo = objfile
End If

oltre all'ulteriore blocco precedentemente postato per l'importazione standard (credo sia la stessa cosa tua).
E' corretto inserirlo in questo modo con ELSEIF?

Ora vorrei provare a fare in modo che, per quanto riguarda la prima procedura che mi hai postato, prenda (e quindi scriva) i txt in un determinato ordine (il vero nome dei txt non è "input_1", "input_2", ma "tizio", "caio",...)
Hai qualche suggerimento per ottenere ciò?
Quello che viene in mente a me è di ripetere il blocco if tante volte quanti sono i file da aprire (ovviamente nell'ordine che voglio), ma non mi sembra una scelta elegante...

Grazie infinite!
di patel data: 22/11/2016 18:04:17
non ho capito bene cosa intendi.
di imparando (utente non iscritto) data: 22/11/2016 22:15:52
Intendo se va bene ottenere il nome con il blocco esleif come postato?

E se c'è un modo per far sì che i txt della procedura che mi hai postato vengano presi in un certo ordine, e non in base a come capita?
Ad esempio vorrei che, avendo input1, input2, e input3, questi vengano scritti secondo un ordine che dico io, ad esempio prima input2, poi input1 e infine input3?
Grazie
di patel data: 23/11/2016 07:39:44

Intendo se va bene ottenere il nome con il blocco esleif come postato? NON HO CAPITO A COSA SERVIREBBE

E se c'è un modo per far sì che i txt della procedura che mi hai postato vengano presi in un certo ordine, e non in base a come capita? OCCORRE UN ELENCO DEI FILE MAGARI IN UNA COLONNA E APRIRLI SECONDO QUELLA SEQUENZA
di imparando (utente non iscritto) data: 23/11/2016 11:31:56
NON HO CAPITO A COSA SERVIREBBE. A valorizzare la variabile file_mo, che poi passo all'importazione di Excel. Credo che sia la stessa cosa che hai postato tu.

OCCORRE UN ELENCO DEI FILE MAGARI IN UNA COLONNA E APRIRLI SECONDO QUELLA SEQUENZA
Supponiamo che io ho l'elenco (ovvero l'elenco delle parole che devono essere contenute in quel file - per esempio prendi per primo il file che contiene la parola tizio, per secondo quello che contiene la parola caio, ecc), potresti postarmi il codice con cui fare ciò?

Grazie mille patel!
di patel data: 23/11/2016 12:17:43
supponiamo è troppo vago, dove le hai le parole ? quante sono ? ormai mi dovresti conoscere
di imparando (utente non iscritto) data: 23/11/2016 15:06:41
ok, provo a spiegarmi meglio..
con il codice (già utilissimo) che mi hai inviato nei giorni scorsi (in particolare nel messaggio del 21/11/2016 12:33:29) andavamo a cercare nella cartella contenente ad esempio 10 txt solo quelli in cui il nome conteneva il numero 5 o il numero 8 (quindi solo input_5 e input_8). Io vorrei dirgli invece di fare la stessa identica cosa, ma nell'ordine che stabilisco io, ovvero ad esempio prendere prima input_8 e dopo input_5.
PS: il nome dei txt è puramente casuale, nel senso che non contengono numeri, ma parole (voglio cercare sempre le stesse parole).

Spero di essere stato più chiaro
Grazie
di patel data: 23/11/2016 15:11:29
sei chiaro ma non hai neppure letto le mie domande
di imparando (utente non iscritto) data: 23/11/2016 15:26:52
dove le hai le parole ? POSSO INSERIRLE IN UN MINI-ARRAY
quante sono ? SONO 5
quali sono ? SONO TIZIO, CAIO, SEMPRONIO, DUCATI, ALFA

di patel data: 23/11/2016 19:10:14
prova questa modificando l'array

Sub importa5()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("F:DocumentiExcelfileMacro-VBACsvA") ' <<<< da modificare
R = 1
arr = Array("5", "4", "3", "2", "1")
For i = 1 To 4
 For Each objfile In objFolder.Files
  ext = LCase(Right(objfile.Name, 3))
  If ext = "txt" And InStr(objfile.Name, arr(i)) > 0 Then
    Set objTF = objFSO.OpenTextFile(objfile, 1)
    strIn = objTF.readall
    p = InStr(strIn, vbCrLf)
    Y = Right(strIn, Len(strIn) - p - 1)
    'Y = Replace(strIn, "DATI" & vbCrLf, "")
    Y = Replace(Y, vbCrLf, ";")
    Y = Replace(Y, "*", vbCr)
    Y = Replace(Y, ",", ";")
    Y = Replace(Y, ";;", "")
    Y = Replace(Y, "durata;", "durata")
    Y = Right(Y, Len(Y) - 1)
    X = Split(Y, vbCr)
    Cells(R, 1).Resize(UBound(X) + 1, 1) = Application.Transpose(X)
    objTF.Close
    R = Cells(Rows.Count, "A").End(xlUp).Row + 1
  End If
 Next
Next
Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Semicolon:=True

End Sub

di imparando (utente non iscritto) data: 24/11/2016 01:44:32
Fantastico, non ho ancora avuto modo di provare, ma ho capito il procedimento! Solo una precisazione, i non dovrebbe andare da 1 a 5?
Comunque domani testo e ti invio un feedback, grazie grazie patel!!!
di imparando (utente non iscritto) data: 24/11/2016 16:55:00
Ciao patel,

confermo che "i" dovrebbe andare "da 0 a 4".

Ora è tutto perfetto come volevo, grazie infinite!!

Magari tornerà utile anche ad altri!
di patel data: 24/11/2016 17:49:20
beene ! la prossima volta dillo subito cosa vuoi invece di arrivarci da lontano e perdere un sacco di tempo

Vuoi Approfondire?