Dividere un grande file in tanti piccoli file.
CC13
codice che si ripete N volte, quindi un nuovo codice che si ripete anche esso
per N volte, e così via per centinaia/migliaia di righe (esempio: il codice
0001 si ripete per 10 volte, quindi occupa le prime 10 righe; dall’undicesima
riga comincia il codice 0002 che di ripete 6 volte; dalla diciasettesima riga
comincia il codice 0003, ecc.). Vorrei spaccare il file in tanti “piccoli”
file, quanti sono i codici riportati nella prima colonna e che riportino
tutti le 8 colonne del file generale con i dati in esse contenuti (cioè un
file di 10 righe con i dati del codice 0001; un file di 6 righe con i dati
del codice 0002; ecc.). I “piccoli” file dovrebbero avere come nome il codice
che riportano nella prima colonna e mantenere la formattazione del file
generale originario (intestazione e piè di pagina, intestazione colonne, tipo
carattere, ecc.).
Chiedo troppo?
Grazie.
eliano
"CC13" ha scritto:
Ciao Cicci13.
Non si chiede mai "troppo"; per male che vada non avrai risposte. :-))
Vedi se ti può essere utile come traccia un lavoretto fatto per una amica
qualche anno fa'; con poche modifiche dovresti ottenere quello che cerchi.
Sul mio disco remoto: http://mio.discoremoto.alice.it/falinieliano il file
Autenti.zip che contiene una sottocartella necessaria per l'esecuzione, oltre
a due file XL, uno dei quali (CreaFogliUtentiEsterni.xls) dovrebbe fare
quello che chiedi.
Ovviamente copia la cartella sul tuo disco, apri il file .xls e clicca sullo
shape colorato: Crea un file per utente.
Prova anche il file CreaFogliUtentiInterniClic.xls, vedi mai.
Saluti
Eliano
r
ciao Mitico! e ciao CC13
non ho scaricato il tuo file ... anche se sono sicuro
che è un lavoro del cavolo :-)
scherzi a parte :-D propongo una soluzione già
adattata alle esigenze di CC13 che non chiede
troppo ... ma lavora male :-) comunque contento
lui ... io spero solo di proporre un lavoro riciclabile
almeno in parte.
Veniamo al dunque, cc13 dovrà preparare il suo
foglio in questo modo:
1) eliminare tutte le colonne e le righe prive di utilità
questo potrebbe velocizzare la macro
2) Const riga_int indica la posizione della riga di
intestazione adesso impostata come prima riga del
foglio
3) Const sFolderDest è il nome della cartella di
destinazione dei nuovi file verrà creata (se già non
esiste nella posizione in cui si trova il tuo file
4) il codice è commentato dove necessario
un grasso saluto a Eliano da tutta la tribu :-)
Option Explicit
Const riga_int As Long = 1 '<< da verificare
Const sFolderDest As String = "FileDelMenga" '<< da cambiare
Sub LavoroDelMenga()
Dim dic As Object
Dim rng As Excel.Range
Dim i As Long, v
Dim Sh As Worksheet
Dim sPath_Dest As String
Dim sEst As String
Dim N_Fogli As Long
'setto il dizionario
Set dic = CreateObject("scripting.dictionary")
'setto la prima colonna col solo range utilizzato
Set rng = ActiveSheet.UsedRange
Set rng = rng.Offset(1).Resize(rng.Rows.Count - riga_int, 1)
N_Fogli = Application.SheetsInNewWorkbook
'ricordo l'impostazione predefinita
Application.SheetsInNewWorkbook = 1
'disattivo i messaggi di Excel
'in questo caso:
'serve nel caso i file esistano già
'a sovrascriverli senza il messaggio
'che ne richiede il permesso
Application.DisplayAlerts = False
'verrà verificato se esiste una cartella
'dal nome della costante sFolderDest nella
'stessa posizione di questo file
'se non esiste viene creata
sPath_Dest = ThisWorkbook.Path & _
Application.PathSeparator & _
sFolderDest & _
Application.PathSeparator
If EsisteFolder(sPath_Dest) = False Then
CreaFolder sPath_Dest
End If
'recupero l'estensione del file (così versione di
'Excel diverse sono ugualmente supportate)
sEst = "." & EstensioneFile(ThisWorkbook.Name)
'passo i valori del range ad un vettore
'visto che il ciclo potrebbe essere lungo
v = rng.Value
'carico i valori univoci della prima colonna
'successivamente serviranno per nominare il
'nuovo file e per filtrare l'elenco
For i = 1 To UBound(v, 1)
If dic.exists(CStr(v(i, 1))) = False Then
dic.Add v(i, 1), 0
End If
Next
'elimino eventuale stringa vuota
If dic.exists("") Then
dic.Remove ""
End If
'in successione:
'copio il foglio attivo in nuova cartella
'lo filtro
'ripulisco le righe nascoste
'elimino il filtro
'chiudo e salvo
For Each v In dic.Keys
ActiveSheet.Copy
Set Sh = ActiveSheet
Filtro_1 Sh, CStr(v)
EliminaRigheNascoste Sh
EliminaFiltro Sh
Sh.Parent.Close True, sPath_Dest & v & sEst
Next
'reimposto le opzioni
Application.DisplayAlerts = True
Application.SheetsInNewWorkbook = N_Fogli
End Sub
Sub CreaFolder(sFolder As String)
Dim fso As Object
Set fso = CreateObject("scripting.filesystemobject")
fso.CreateFolder (sFolder)
End Sub
Sub Filtro_1(Sh As Worksheet, sCriterial As String)
Dim rng As Excel.Range
Set rng = Sh.UsedRange
Set rng = rng.Offset(1).Resize(rng.Rows.Count - riga_int + 1, 1)
rng.AutoFilter 1, sCriterial, , , False
End Sub
Sub EliminaRigheNascoste(Sh As Worksheet)
Dim rng As Excel.Range
Dim l As Long
For l = Sh.UsedRange.Rows.Count To 1 Step -1
If Sh.Cells(l, 1).EntireRow.Hidden = True Then
Sh.Cells(l, 1).EntireRow.Delete
End If
Next
End Sub
Sub EliminaFiltro(Sh As Worksheet)
If Sh.FilterMode Then
Sh.Cells.AutoFilter
Sh.Cells(1, 1).Select
End If
End Sub
Function EstensioneFile(sNomeFile As String) As String
Dim fso As Object
Set fso = CreateObject("scripting.filesystemobject")
EstensioneFile = fso.GetExtensionName(sNomeFile)
End Function
Function EsisteFolder(sFolder As String) As Boolean
Dim fso As Object
Set fso = CreateObject("scripting.filesystemobject")
EsisteFolder = fso.FolderExists(sFolder)
End Function
saluti
r
--
Come e dove incollare il codice:
http://www.rondebruin.nl/code.htm
Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html
r
5) copia incolla tutto il codice in un modulo
standard
6) seleziona il foglio e lancia LavoroDelMenga
r
Set rng = rng.Offset(riga_int).Resize(rng.Rows.Count - riga_int, 1)
eliano
"r" ha scritto:
> ciao Mitico! e ciao CC13
> non ho scaricato il tuo file ... anche se sono sicuro
> che è un lavoro del cavolo :-)
>
> un grasso saluto a Eliano da tutta la tribu :-)
>
Ciao Roby.
Ho detto a Cicci di scaricarlo, non a te; non me lo sarei mai permesso, dato
che si tratta della prova per un lavoro fatto per una associazione a
delinquere che trattava e tratta slot machines, fatto nel lontano 2004.
Concordo con te che si tratta di un lavoro del cavolo, anche se tuttora
funzionante, realizzato con "perfetta" tecnica artigianale, anche in
considerazione del fatto che sentii parlare per la prima volta del Vba
nell'anno 2003. :-))
Contraccambio con i più freschi saluti a te e tutta la tribù,
Eliano
P.S.
Ho copiato le tue routines che mi riservo di provare appena troverò la forza
e la voglia di farlo, anche se sono sicuro che sarà funzionante come al
solito.
r
ciao Mitico,
io nel 2003 ero appena nato :-) stai diventando sclerotico
hai dimenticato di citare o di leggere quel
"Scherzi a parte :-D" dal mio intervento?
Quando mi permetto di prendere in giro qualcuno
spesso è ... perchè ne ho stima, capita con te come con
altri *veterani dell'NG*.
Tornando al tuo ridicolo codice ... e ridaglie :-D
sono sicuro che funzionerà per altri 10 anni!
Adesso tornerò serio per alcune righe e un po'
che voglio dirlo :-) ...
Tu meriteresti una vera e propria investitura in questo NG
(e non parlo di un trattore guidato da me o di una medaglia
d'argento :-)
(Aggiungo ... Te come Mauro ovviamente ... magari una
in due visto che siete fratelli :-D)
Spesso mi sono chiesto come mai non
sia/no ancora arrivata/e ... forse qualcuno dovrebbe darsi
una svegliata! BIIiiL ...
Bada ciò che ho detto non ha alcun valore legale
e sono pronto a ritrattare tutto!
Anzi nego fin d'ora
d'avrlo detto!
eliano
"r" ha scritto:
Ciao Roby.
A Milano deve far più caldo che a Pistoia.:-))
Non vorrei che avessi frainteso la mia risposta e ti confermo che avevo bel
letto il tutto, oltre a confermarti che quando si tratta di scherzare avrei
la presunzione di trovarmi nelle prime posizioni; inoltre sarebbe contro la
mia natura reagire, se non con una battuta equivalente, di fronte ad una
"presa per il sellino" praticata da un amico nei miei confronti. "Amici miei"
l'abbiamo inventati in Toscana! :-))
Vedi Roby, io tengo molto alla mia artigianalità [che fra l'altro fa schifo
a fratello Mauro :-D)] e le mie conoscenze nel Vba sono talmente relative che
se zio Bill ne fosse messo al corrente, mi espellerebbe direttamente dal NG;
quindi, cortesemente, ti prego, non lo invocare, lasciamolo stare dov'è,
anche perchè la sua faccia mi resta un po' antipatica. ^_^
Ti confermo i miei saluti a tutta la tribù che, data la calura, avevo
preventivamente messo in frigo, pensando di farti cosa gradita.
Eliano
eliano
"r" ha scritto:
> Tornando al tuo ridicolo codice ... e ridaglie :-D
> sono sicuro che funzionerà per altri 10 anni!
Dimenticavo: grazie per l'augurio, sempre che nei prossimi dieci anni non
"imbuchino" tutta l'associazione a delinquere. :-))