| | Post: 11 | Registrato il: 29/05/2015
| Età: 35 | Utente Junior | 2007/2010/2013 | | OFFLINE | |
|
  04/07/2017 23:46 | |
Buonasera, so che avete già preso tale discussione ma cercando non ho trovato niente che potesse interfacciarsi al mio risultato quindi spero possiate aiutarmi.
Vi spiego brevemente.
allora io ogni giorno, devo organizzare dei trasferimenti per i clienti da e per la struttura, quindi da un file MASTER preparo le partenze e gli arrivi, fin qui tutto ok , il punto e che dopo aver generato ogni file per ogni partenza/arrivo devo fare un file riepilogativo riportando nuovamente tutte le info già scritte... quindi
tipo di trasferimento
data
provenienza volo
ora
n persone
mezzo utilizzato
il punto e che vorrei (utilizzando come esempio il file di arrivo) creare una macro che prendesse tutti gli arrivi della cartella ARRIVI prendesse per ogni file le informazioni dette e le riportasse in automatico (poi per il file partenze modifico eventualmente la macro o il codice degli arrivi)
il punto e che i file da dove estrarre i dati hanno come nome questa variabile "03LUGLIO ROSSI MARIO 10.10.xls" dove la data cambia ovviamente come il nome e l'orario,
vi allego anche i file di esempio dove MASTER e il file dove devo infilare tutti i dati di tutti i trasferimenti e l'altro un esempio di una bolla di traferimento
spero possiate aiutarmi mi semplifichereste parecchio la stagione lavorativa ![[SM=x423063]](http://www.erismag.it/Servizio/ForumExcel/Smiles/Faccina_0043.gif) |
|
| | Post: 1.451 | Registrato il: 06/04/2013
| Utente Veteran | 2010 | | OFFLINE |
|
| 05/07/2017 10:28 | |
Ciao
premessa: la cartella ARRIVI (così come la cartella PARTENZE) conterrà soltanto i file relativi.
Non interrompere la macro altrimenti resta un'istanza (nascosta) di excel aperta.
In un modulo del tuo MASTER che NON deve stare in una delle due cartelle suddette:
Sub Riepilogo()
Dim oExcel As Excel.Application
Dim strFile As String
Dim FileCorrente As Object
Dim r As Integer
Dim mFoglio As String
On Error GoTo errore
Set FileCorrente = ActiveSheet
Set oExcel = New Excel.Application
worksheets("ARRIVI CON ORDINE").select
' cartella contenente i file da cui copiare seguita da \
mFolder = "C:\TuaCartella\ARRIVI\"
mFoglio = "Foglio1" ' foglio file cliente con dati
r = Range("A" & Rows.Count).End(xlUp).Row 'variabile riga
If r > 4 Then
Range("A5:K" & r).ClearContents
End If
r = 5
strFile = Dir(mFolder & "*.xls")
'inizia ciclo lettura
Do While strFile <> ""
' in oExcel ci vanno a finire di volta in volta _
i file contenuti nella cartella
oExcel.Workbooks.Open mFolder & strFile
FileCorrente.Cells(r, 1) = oExcel.Worksheets(mFoglio).Range("E24") & " " & oExcel.Worksheets(mFoglio).Range("G11")
FileCorrente.Cells(r, 2) = oExcel.Worksheets(mFoglio).Range("G15")
FileCorrente.Cells(r, 3) = oExcel.Worksheets(mFoglio).Range("G19")
FileCorrente.Cells(r, 5) = oExcel.Worksheets(mFoglio).Range("G17")
FileCorrente.Cells(r, 7) = oExcel.Worksheets(mFoglio).Range("G13")
FileCorrente.Cells(r, 10) = oExcel.Worksheets(mFoglio).Range("G21")
oExcel.ActiveWorkbook.Close False
strFile = Dir
r = r + 1
Loop
' chiude e azzera variabili
xit:
On Error Resume Next
oExcel.Quit
Set oExcel = Nothing
Range("A1").Select
Exit Sub
errore:
MsgBox Err.Number & " " & Err.Description
Resume xit
End Sub saluti [Modificato da dodo47 05/07/2017 10:32] Domenico
Win 10 - Excel 2016 |
| | Post: 11 | Registrato il: 29/05/2015
| Età: 35 | Utente Junior | 2007/2010/2013 | | OFFLINE | |
|
| 05/07/2017 22:05 | |
oddio grazie!!! fa esattamente quello che mi serviva!!!!! ti ringrazio tantissimo!!!! davvero non hai idea di quanto tu mi abbia aiutato!! dover generare 100/200 trasferimenti con relativi dati per poi ritrascriverli ogni volta....era un delirio con la probabilità di non trascrivere alcuni per errore e distrazione..!!! grazie infinite !! |
| | Post: 12 | Registrato il: 29/05/2015
| Età: 35 | Utente Junior | 2007/2010/2013 | | OFFLINE | |
|
| 06/07/2017 10:23 | |
salve nuovamente, ringraziandoti ancora avrei solo un ultima domanda se nel caso i file da cui voglio estrapolare i dati diventassero da xls a xlsx dovrei solo cambiare il codice
strFile = dir (mFolder & "*.xls") con l'estensione xlsx?
grazie!! |
| | Post: 13 | Registrato il: 29/05/2015
| Età: 35 | Utente Junior | 2007/2010/2013 | | OFFLINE | |
|
| 06/07/2017 11:09 | |
ho risolto per l'estensione cambiando appunto il formato sulla formula posso tranquillamente decidere cosa deve pescare. ho solo un problema tecnico
ho notato che la formula giustamente trascrive tutto nel foglio master e cancella e riscrive se rilancio il comando, sarebbe possibile far si che non vada a trascrivere la colonna F e la colonna K nelle quali dovrò mettere delle macro fisse altrimenti me le cancella ogni volta?
grazie davvero per tutto |
| | Post: 1.452 | Registrato il: 06/04/2013
| Utente Veteran | 2010 | | OFFLINE |
|
| 06/07/2017 19:47 | |
Ciao
sostituisci il ciclo di cancellazione con:
If r > 4 Then
Range("A5:E" & r).ClearContents
Range("G5:J" & r).ClearContents
End If
saluti Domenico
Win 10 - Excel 2016 |
| | Post: 14 | Registrato il: 29/05/2015
| Età: 35 | Utente Junior | 2007/2010/2013 | | OFFLINE | |
|
| 07/07/2017 20:48 | |
Scusi il ritardo!!! Perfetto ho sistemato anche questo fattore, ho solo (spero) un ultima domanda da porle se puo darmi risposta.
Quando vengono compilati i dati ho notato che non vengono automaticamente generate le celle in base alla struttura e tema degli stessi. Sarebbe possibile che in automatico ricopiasse la struttura della cella superiore in modo da riproportla uguale? Se questo non e ppssibile lo faccio manualmente :) per il resto grazie davvero tanto!!! |
| | Post: 1.459 | Registrato il: 06/04/2013
| Utente Veteran | 2010 | | OFFLINE |
|
| 08/07/2017 16:55 | |
Ciao
già sono anziano...poi mi dai del lei e....
dammi del tu ;)
Ho apportato qualche rettifica:
nota: la formattazione la prendo sempre dalla riga 5 che pertanto deve essere formattata come tu vuoi.
saluti
Sub Riepilogo()
Dim oExcel As Excel.Application
Dim strFile As String
Dim FileCorrente As Object
Dim r As Integer
Dim mFoglio As String
On Error GoTo errore
Application.ScreenUpdating = False
Set FileCorrente = ActiveSheet
Set oExcel = New Excel.Application
Worksheets("ARRIVI CON ORDINE").Select
' cartella contenente i file da cui copiare seguita da \
mFolder = "C:\TuaCartella\ARRIVI\"
mFoglio = "Foglio1" ' foglio file cliente con dati
r = Range("A" & Rows.Count).End(xlUp).Row 'variabile riga
If r > 4 Then
Range("A5:E" & r).ClearContents
Range("G5:J" & r).ClearContents
End If
r = 5
Range("A5:K5").Copy
strFile = Dir(mFolder & "*.xls")
'inizia ciclo lettura
Do While strFile <> ""
' in oExcel ci vanno a finire di volta in volta _
i file contenuti nella cartella
oExcel.Workbooks.Open mFolder & strFile
FileCorrente.Cells(r, 1) = oExcel.Worksheets(mFoglio).Range("E24") & " " & oExcel.Worksheets(mFoglio).Range("G11")
FileCorrente.Cells(r, 2) = oExcel.Worksheets(mFoglio).Range("G15")
FileCorrente.Cells(r, 3) = oExcel.Worksheets(mFoglio).Range("G19")
FileCorrente.Cells(r, 5) = oExcel.Worksheets(mFoglio).Range("G17")
FileCorrente.Cells(r, 7) = oExcel.Worksheets(mFoglio).Range("G13")
FileCorrente.Cells(r, 10) = oExcel.Worksheets(mFoglio).Range("G21")
Range("A" & r).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
oExcel.ActiveWorkbook.Close False
strFile = Dir
r = r + 1
Loop
' chiude e azzera variabili
xit:
On Error Resume Next
oExcel.Quit
Set oExcel = Nothing
Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Fine elaborazione"
Exit Sub
errore:
MsgBox Err.Number & " " & Err.Description
Resume xit
End Sub[Modificato da dodo47 08/07/2017 16:56] Domenico
Win 10 - Excel 2016 |
| | Post: 15 | Registrato il: 29/05/2015
| Età: 35 | Utente Junior | 2007/2010/2013 | | OFFLINE | |
|
| 08/07/2017 22:08 | |
ciao grazie nuovamente e scusami allora per il Lei :D :D io ti scrivo mentre lavoro quindi eventuali modifiche e accorgimenti sono dettate dalle necessità lavorative heheheh le modifiche fatte sono perfetto!!! solo un piccolo dettaglio che ora ti spiego,
so che sto abusando del tuo prezioso tempo ma avrei da chiederti altre due cose se possibile.
1) dopo la copia dei dati sarebbe utile (per velocizzare il tutto) che alla fine della colonna numero passeggeri venga fatta la cella somma per il totale dei passeggeri che ora giustamente viene cancellata dalla generazione delle celle copiate,
2)da tutto il contesto ho purtroppo lasciato fuori un altro file che andrebbe preso (ma questo non e necessario se complica il tutto ) praticamente oltre alle bolle abbiamo un altro fornitore di trasferimenti. ma questo file risulta un po più complesso del primo in quanto non ha celle fisse è un elenco di servizi (esteticamente riprende il file di riepilogo) dove ci possono essere piu o meno mezzi. il fatto e che questo file è fatto in 2 spezzoni arrivi e partenze (ti allego per farti capire meglio) quindi se e possibile infilare anche lui in questo minestrone di arrivi e partenze dove ovviamente il foglio degli arrivi prende solo gli arrivi e quello delle partenze solo le partenze... ma ripeto se prende troppo lavoro tempo e fatica (che già hai dedicato in abbondanza a me, puoi anche lasciare stare hai già fatto tantissimo e per questo te ne sono infinitamente grato!) per comodità ti metto anche il file che attualmente ho sistemato anche per le partenze così mi dai un tuo parere :) dove ho messo anche delle regole SE sull'ora per recuperare tempo anche su quello :D |
| | Post: 1.461 | Registrato il: 06/04/2013
| Utente Veteran | 2010 | | OFFLINE |
|
| 09/07/2017 15:48 | |
Ciao
1) dopo Loop e prima di xit: inserisci:
Cells(r + 1, 7) = Application.WorksheetFunction.Sum(Range("G5:G" & r - 1))
2) troppe differenze...colonne diverse...tutto su un foglio.
saluti
Domenico
Win 10 - Excel 2016 |
| | Post: 16 | Registrato il: 29/05/2015
| Età: 35 | Utente Junior | 2007/2010/2013 | | OFFLINE | |
|
| 09/07/2017 16:20 | |
Perfetto ti ringrazio davvero per tutto !!!! Sei stato gentilissimo |
|
|
|
|