creare un unico file con dati specifici in un foglio.

27 views
Skip to first unread message

Ki$$

unread,
Oct 26, 2021, 12:04:30 PM10/26/21
to
allora...

...beh faccio prima a linkare il file da manipolare.
http://wikisend.com/download/128962/FRED.xlsx

In pratica io vorrei in un nuovo file TXT tutti i dati, specificati sotto,
del foglio uno sopra l'altro.

PS: Le colonne potrebbero essere un numero indefinito (così come le righe)

Prendendo come esempio le prime due colonne del file che ho uploadato
(sopra):

il risultato è sotto (ovviamente il file dovrebbe includere TUTTE le colonne
del foglio nel risultato finale e non solo le prime due dell'esempio):

sono Tre campi: Simbolo, Data, Valore.

Symbol;Date;Value
WGS10YR;05/01/1962;4,0
WGS10YR;12/01/1962;4,1
WGS10YR;01/19/1962;4,1
WGS10YR;01/26/1962;4,1
WGS10YR;02/02/1962;4,1
WGS10YR;09/02/1962;4,1
WGS10YR;02/16/1962;4,0
WGS10YR;02/23/1962;4,0
fino all'ultima riga che in questa colonna è la 3128
WFII10;03/01/2003;2,4
WFII10;10/01/2003;2,4
WFII10;01/17/2003;2,3
WFII10;01/24/2003;2,2
WFII10;01/31/2003;2,2
WFII10;07/02/2003;2,1
WFII10;02/14/2003;2,0
WFII10;02/21/2003;2,0
WFII10;02/28/2003;1,8
fino all'ultima riga che in questa colonna è la 988

...e così via per il resto delle colonne del foglio (che come ho scritto
sopra potrebbero essere un numero indefinito....)


PS2: sarebbe utile un bottoncino che faccia tutto automaticamente.

grazie per l'eventuale aiuto.
Ki$$

Ki$$

unread,
Oct 26, 2021, 12:08:30 PM10/26/21
to
> allora...

> ...beh faccio prima a linkare il file da manipolare.
> http://wikisend.com/download/128962/FRED.xlsx

> In pratica io vorrei in un nuovo file TXT tutti i dati, specificati sotto,
> del foglio uno sopra l'altro.

oppure invece di un unico file (che potrebbe essere troppo grande di
dimensione) potrebbe anche andare bene tanti file TXT quante sono le colonne
da elaborare)

si, forse è meglio così.

Bruno Campanini

unread,
Oct 27, 2021, 12:37:51 PM10/27/21
to
After serious thinking Ki$$ wrote :
Prova questa;
==================================
Public Sub Arrange()
Dim i, k, NewSheets() As String, SR As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set SR = [Fred!A1:XFD1]
For i = 1 To 16384 Step 2
If SR(1, i) <> "" Then
k = k + 1
ReDim Preserve NewSheets(1 To k)
NewSheets(k) = SR(1, i)
End If
Next

For i = 1 To UBound(NewSheets)
Sheets.Add.Name = NewSheets(i)
Next
For i = 1 To UBound(NewSheets)
Range([Fred!A8], [Fred!A8].End(xlDown).Resize(, 2)).Copy Sheets
(NewSheets(i)).Range("A1")
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
===================================

Bruno

Ki$$

unread,
Oct 27, 2021, 12:54:03 PM10/27/21
to
ti darei un bacio (sulla guancia).

Grazie, provo subito e poi ti faccio sapere :)

Tks
Ki$$

Ki$$

unread,
Oct 27, 2021, 1:03:45 PM10/27/21
to
ok mi crea un foglio per ogni serie di dati.
Ora potresti crearmi un pulsante con il quale posso esportarli tutti quanti
ognuno col proprio nome foglio in tanti files TXT in una cartella nominata
"Fred Data"?

casanmaner

unread,
Oct 27, 2021, 1:19:00 PM10/27/21
to
Prova a vedere questo file:
https://www.dropbox.com/s/zjbk2ygnpqk6aim/FRED.xlsm?dl=0

nel modulo1 è presente una procedura nominata "TEST" che si appoggia ad altre funzioni (due sono di Norman Jones) per trovare l'ultima colonna, l'ultima riga di ogni intervallo e creare il file di testo.
I file txt vengono salvati nello stesso percorso dove si trova il file excel.
Ma volendo si potrebbe indicare un percorso diverso indicandolo in corrispondenza della variabile sPath.


Sub TEST()
Dim ws As Worksheet
Dim i As Long, y As Long
Dim iLastCol As Long, iLastRow, iTotalRows As Long
Dim sSymbol As String
Dim arrDate As Variant
Dim arrValue As Variant
Dim sTesto As String

Dim sPath As String

With ThisWorkbook
Set ws = .Worksheets(1)
sPath = .Path
If Right(sPath, 1) <> Application.PathSeparator Then
sPath = sPath & Application.PathSeparator
End If
End With

iLastCol = LastCol(ws, ws.UsedRange)
With ws
For i = 1 To iLastCol Step 2
iLastRow = LastRow(Cells(1).Parent, .Columns(i), 8)
iTotalRows = iLastRow - 7
sSymbol = .Cells(1, i).Value
arrDate = .Cells(8, i).Resize(iTotalRows).Value
arrValue = .Cells(8, i + 1).Resize(iTotalRows).Value
sTesto = "Symbol;Date;Value"

For y = 1 To iTotalRows
If IsError(arrValue(y, 1)) Then arrValue(y, 1) = "#N/D"
sTesto = sTesto & vbNewLine & sSymbol & ";" & arrDate(y, 1) & ";" & arrValue(y, 1)
Next y
Call ScriviFileTesto(sPath & sSymbol & ".txt", sTesto, True)
Next i
End With ' ws
End Sub

Public Function LastRow(sh As Worksheet, _
Optional Rng As Range, _
Optional minRow As Long = 1, _
Optional strPassword As String = "")
'by Norman David Jones
Dim bProtected As Boolean
With sh
If Rng Is Nothing Then
Set Rng = .Cells
End If
bProtected = .ProtectContents = True
If bProtected Then
.Unprotect Password:=strPassword
End If
End With
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 < minRow Then
LastRow = minRow
End If
If bProtected Then
sh.Protect Password:=strPassword ', UserInterfaceOnly:=False
End If
End Function

Public Function LastCol(sh As Worksheet, _
Optional Rng As Range, _
Optional minCol As Long = 1, _
Optional strPassword As String = "")
'by Norman David Jones
Dim bProtected As Boolean
With sh
If Rng Is Nothing Then
Set Rng = .Cells
End If
bProtected = .ProtectContents = True
If bProtected Then
.Unprotect Password:=strPassword
End If
End With
On Error Resume Next
LastCol = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
If LastCol < minCol Then
LastCol = minCol
End If
If bProtected Then
sh.Protect Password:=strPassword ', UserInterfaceOnly:=False
End If
End Function

Sub ScriviFileTesto(sFileFullName As String, _
sCorpoTesto As String, _
Optional bSovrascrivi As Boolean = True)
Dim Fso As Object, File As Object
Dim iMode As Long
If sFileFullName = vbNullString Then Exit Sub
Set Fso = CreateObject("Scripting.FileSystemObject")
If bSovrascrivi Then
iMode = 2
Else
iMode = 8
End If
With Fso
With .OpenTextFile(sFileFullName, iMode, True)
If bSovrascrivi Then
.Write sCorpoTesto
Else
.WriteLine sCorpoTesto
End If
.Close
End With
End With 'Fso
Set Fso = Nothing
End Sub

Ki$$

unread,
Oct 27, 2021, 1:39:51 PM10/27/21
to
perfettissimo. Sei sempre il numero 1.
(Grazie anche a Bruno per l'aiuto prezioso)

Ki$$

Ki$$

unread,
Oct 27, 2021, 1:57:31 PM10/27/21
to
> Il giorno martedì 26 ottobre 2021 alle 18:08:30 UTC+2 Ki$$ ha scritto:
>>> allora...
>>
>>> ...beh faccio prima a linkare il file da manipolare.
>>> http://wikisend.com/download/128962/FRED.xlsx
>>> In pratica io vorrei in un nuovo file TXT tutti i dati, specificati
>>> sotto, del foglio uno sopra l'altro.
>> oppure invece di un unico file (che potrebbe essere troppo grande di
>> dimensione) potrebbe anche andare bene tanti file TXT quante sono le
>> colonne da elaborare)
>>
>> si, forse è meglio così.
> Prova a vedere questo file:
> https://www.dropbox.com/s/zjbk2ygnpqk6aim/FRED.xlsm?dl=0

> nel modulo1 è presente una procedura nominata "TEST" che si appoggia ad
> altre funzioni (due sono di Norman Jones) per trovare l'ultima colonna,
> l'ultima riga di ogni intervallo e creare il file di testo. I file txt
> vengono salvati nello stesso percorso dove si trova il file excel. Ma
> volendo si potrebbe indicare un percorso diverso indicandolo in
> corrispondenza della variabile sPath.

per esempio se dovessi mettere come destinazione la cartella "Fred Data" sul
desktop?

casanmaner

unread,
Oct 27, 2021, 2:05:38 PM10/27/21
to
Il giorno mercoledì 27 ottobre 2021 alle 19:57:31 UTC+2 Ki$$ ha scritto:

> per esempio se dovessi mettere come destinazione la cartella "Fred Data" sul
> desktop?
dove è indicato
sPath = .Path

al posto di .Path metti il percorso.

Es. "C:\miopercorso\Fred Data"

Ki$$

unread,
Oct 27, 2021, 2:42:28 PM10/27/21
to
ahhhh ecco... :)

Bruno Campanini

unread,
Oct 27, 2021, 6:08:27 PM10/27/21
to
Ki$$ expressed precisely :
Sì, ci vorrà un'altra decina di righe, il tutto è molto semplice.
Ora però mi si chiude già un occhio... lo farò domani.

Bruno

Ki$$

unread,
Oct 27, 2021, 6:26:10 PM10/27/21
to
Bruno non occorre più, ha già risolto casanmaner.
Comunque se vuoi puoi postare lo stesso il resto magari come tutorial.

Bruno Campanini

unread,
Oct 28, 2021, 2:26:15 PM10/28/21
to
Ki$$ wrote :
Come tutorial non ti può servire: sono 30 linee VBA per copiare e
compilare sullo stesso file 78 file bicolonne, indi trasferire
i 78 in una directory col formato TXT.

Bruno

Ki$$

unread,
Oct 28, 2021, 2:50:16 PM10/28/21
to
> Ki$$ wrote :
>>> Ki$$ expressed precisely :
>>>>
>>
>>> Sì, ci vorrà un'altra decina di righe, il tutto è molto semplice.
>>> Ora però mi si chiude già un occhio... lo farò domani.
>>
>>> Bruno
>>
>> Bruno non occorre più, ha già risolto casanmaner.
>> Comunque se vuoi puoi postare lo stesso il resto magari come tutorial.

> Come tutorial non ti può servire: sono 30 linee VBA per copiare e
> compilare sullo stesso file 78 file bicolonne, indi trasferire
> i 78 in una directory col formato TXT.

> Bruno

ok
Reply all
Reply to author
Forward
0 new messages