Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Automatizzare risolutore excel per più file/fogli

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Automatizzare risolutore excel per più file/fogli

Postdi TeUzZz89 » 14/05/13 04:04

Ciao a tutti! Prima di aprire questa richiesta, ho cercato se ci fosse un topic già aperto al riguardo, ma non ho trovato nulla.
Premesso che sono completamente ignorante in tema di macro e vb, ci sarebbe un modo per "automatizzare" il risolutore excel per più file? in quanto quello che devo fare è semplicemente aprire il file/Dati/Risolutore/premere Ok (in quanto le impostazioni sono già predefinite)/attendere il calcolo dei valori/premere ok/salvare il file e ripetere la cosa per tanti altri file! Ci sarebbe un modo per velocizzare tutto questo?
Grazie per la disponibilità e cortesia.
TeUzZz89
Utente Junior
 
Post: 20
Iscritto il: 10/05/13 03:48

Sponsor
 

Re: Automatizzare risolutore excel per più file/fogli

Postdi Anthony47 » 14/05/13 10:44

Registrati una macro in cui avvii il risolutore sul primo foglio (o sulla prima cella del primo foglio) e fai calcolare il risultato; poi inserisci il codice ottenuto in una loop del tipo
Codice: Seleziona tutto
For Each WSh In ActiveWorkbook.Worksheets
    'istruzioni del risolutore
Next WSh

Per avviare la registrazione macro: tab Sviluppo /gruppo Codice, Registra macro.
Qui esegui da tastiera il risolutore
Per interrompere: tab Sviluppo /gruppo Codice, Interrompi registrazione

Questa domanda credo sia legata all' altro quesito (Copiare dati da altri file excel, in particolare viewtopic.php?f=26&t=98337&p=570963#p570936).
Se Si, allora le nuove istruzioni vanno inserite subito dopo l' apertura del file da importare e vanno inoltre condizionate al fatto che il file sia di tipo "K"; come da questo schema
Codice: Seleziona tutto
        Workbooks.Open myPath & "\" & FName   'ESISTENTE
        '==AGGIUNTE
        If J = LBound(myTipo) Then
           For Each WSh In ActiveWorkbook.Worksheets
               'istruzioni del risolutore
           Next WSh
        End If
        '==FINE AGGIUNTE
        If J = 1 + LBound(myTipo) Then        'ESISTENTE
Se non riesci, pubblica il codice prodotto in fase di registrazione macro e vedremo insieme.

Questo ti consentira' di automatizzare l' avvio del Risolutore, ma difficilmente ti accorcera' i tempi di esecuzione che tu dicevi essere "anche un ora e mezza solo per un singolo foglio"; se ogni file contiene 38 fogli il tempo complessivo sara' circa di 57 ore per file; se i file sono 54 allora il tempo complessivo sara' di circa 128 gg.
Insomma, se e' cosi' temo che dovrai trovare una strategia alternativa al Risolutore; se sia possibile o meno dipende dal tipo di elaborazione che va fatta e dalla linearita' o meno del processo da risolvere. Per una valutazione congiunta attendiamo le tue informazioni

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Automatizzare risolutore excel per più file/fogli

Postdi TeUzZz89 » 14/05/13 15:31

Ciao! si inizialmente avevo intenzione di adottarlo per ogni singolo file "K", ma proprio oggi ho "scoperto" che il risolutore è più veloce se elaboro file con all'interno un solo sheet, forse perchè così è meno "appesantito" da altri sheets, ma non ne ho la minima idea, è semplicemente qualcosa che ho riscontrato provando per curiosità. Per cui ho diviso ciascun file K in 38 file diversi (in quanto ogni file K contiene 38 sheets) tramite una macro che ho trovato proprio sul vostro forum (http://www.pc-facile.com/forum/viewtopic.php?t=88095). Ho creato 54 cartelle con all'interno i 38 file e li sto facendo manualmente uno a uno.
Ho registrato il codice della macro come mi hai detto ed è questo:
Codice: Seleziona tutto
Sub prova_risolutore()
'
' prova_risolutore Macro
'

'
    SolverOk SetCell:="$E$1", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$8:$GS$8", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverOk SetCell:="$E$1", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$8:$GS$8", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverSolve
End Sub


Mi chiedo se posso inserirlo comunque in quello che mi avevi scritto prima, dal momento che ora deve passare ad un altro file e non più ad un altro foglio. E inoltre ci sarebbe un modo per ripetere la macro soltanto una volta e quindi non solo per la singola cartella, ma per tutte le cartelle insieme (ad esempio dando come riferimento la directory in cui vi sono tutte le cartelle ed elaborare con il risolutore tutti i file excel in essa contenuti) ?
La mia intenzione sarebbe poi di ripetere l'operazione inversa, ossia di riunire i 38 file, ricreare il famoso file K e infine utilizzare la macro che molto gentilmente mi hai mostrato per ricopiare tutti i risultati in unico file.
Servirebbe una macro che faccia esattamente il processo inverso di questa http://www.pc-facile.com/forum/viewtopic.php?t=88095 per "ricostituire" i file K, anche se forse è un'operazione che potrei fare velocemente anche a mano, ma non ne sono sicuro.
Grazie ancora per la disponibilità e il prezioso aiuto.

Ciao!
TeUzZz89
Utente Junior
 
Post: 20
Iscritto il: 10/05/13 03:48

Re: Automatizzare risolutore excel per più file/fogli

Postdi Anthony47 » 15/05/13 01:33

Effettivamente il tempo di esecuzione del Risolutore su foglio singolo e' drasticamente diverso da quanto richiesto per eseguirsi sul file completo. Anzi peggio: basta che sia aperto un file complesso che il Risolutore rallenta drasticamente.
D' altra parte hai circa 200 variabili da simulare ($B$8:$GS$8) con calcoli fatti su circa 200 colonne * 100 righe...

Noto anche un errore di cui non so valutare la gravita':
-il valore cercato dal Risolutore e' il minimo del risultato di =SOMMA(GW10:GW1117)
-GW10:GW1117 dipende pero' da GU10:GU115, che usano la funzione CERCA
-CERCA pero' richiede che il vettore in cui si cerca contenga valori in ordine crescente, cosa che la tua sequenza ($B$6:$JA$6) non garantisce, contenendo una sequenza di valori alternati positivi /negativi (vedi help on line, che recita "Importante È necessario che i valori in vettore siano disposti in ordine crescente: ...; -2; -1; 0; 1; 2; ...; A-Z; FALSO; VERO. In caso contrario, CERCA potrebbe non restituire il valore corretto")

Direi che dovresti approfondire questo aspetto per essere certo che il modello restituisca un valore corretto.

Quanto all' ipotesi di smembrare ogni file tipo K da 38 fogli in 38 file da un foglio, eseguire la macro di Risolutore sui fogli singoli e poi ricomporre il file da 38 fogli io ne farei un' altra:
-se non erro, gli unici dati variabili sono in A4:GS5, tutto il resto sono formule
-si potrebbe quindi evolvere a un file tipo K contenente un Foglio "Risolutore" con tutte le formule e impostato il Risolutore, e un altro foglio che contiene, in riga 1-2, 5-6, 11-12, 15-16 etc etc il blocco dei dati del settore Automobiles & Parts, Bank, Beverage, Chemicals, etc etc
All' occorrenza ogni blocco di dati e' copiato sul foglio Risolutore, si attiva il risolutore e si copiano i risultati su Tables.xlm.

Fai una prova su un file, se funziona faremo le conversioni con una macro e modificheremo la macro di compilazione di Tables che avevamo gia' collaudato.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Automatizzare risolutore excel per più file/fogli

Postdi TeUzZz89 » 15/05/13 03:07

Si in effetti guardando bene dice proprio così. Il fatto è che sto facendo questa tesi a melbourne e il professore che mi sta seguendo mi ha dato personalmente questo file da utilizzare per questo particolare test e sinceramente, una volta capito in cosa consiste a livello teorico, non sono andato a verificare effettivamente come fosse strutturato il file e mi sono limitato ad inserire i dati in input (manualmente, sprecando un sacco di tempo! :) ). Comunque farò notare questa cosa la prossima volta che lo incontro, grazie.
Per quanto riguarda la seconda cosa, volevo continuare in quel modo solo perchè ormai ho scomposto i file e stavo andando avanti, seppur manualmente, in questa direzione. Sicuramente, se ho capito bene, la tua strada è più veloce, ma il motivo per cui vorrei lasciare che il risolutore calcolasse ogni singolo foglio è che, precedentemente, una volta inseriti i dati in input, ho dovuto svolgere delle modifiche ad hoc per ciascun foglio. Tali modifiche dipendono strettamente dai dati in input, in quanto ogni volta cambia il valore max in G2 e manualmente dovevo modificare piccole cose, che però ho svolto a mano e probabilmente, anche in questo caso, ci sarebbe stato un modo più rapido tramite l'utilizzo di una macro; fatto sta che è per questo che vorrei "mantenere" i fogli così come sono ed andare avanti per questa strada.
So che forse non sono stato chiarissimo, e anzi probabilmente la tua via sarebbe più semplice e veloce, però ciò significherebbe apportare nuovamente quelle modifiche manualmente e quindi non saprei come fare.
Grazie come sempre per l'aiuto.

Ciao!
TeUzZz89
Utente Junior
 
Post: 20
Iscritto il: 10/05/13 03:48

Re: Automatizzare risolutore excel per più file/fogli

Postdi Anthony47 » 15/05/13 22:19

Il fuso orario non aiuta a dialogare, quindi ho deciso di procedere come hai immaginato tu pur non approvando la scelta, anche perche' la macro gia' sviluppata conteneva i building blocks necessari anche alla nuova macro.
La nuova macro esegue queste operazioni:
-riceve le indicazioni della directory che contiene tutti i file di tipo K
-legge da un file l' elenco dei fogli presenti
-poi uno dopo l' altro apre i file tipo K e li processa:
--ogni foglio A ECCEZIONE di quelli chiamati SheetN (quindi eccetto i fogli Sheet1 e Sheet2) viene enucleato dal file a cui appartiene e viene salvato con un nome di servizio nella subdirectory "work" che deve essere gia' presente nella directory che contiene i file K. A conclusione del processo il file K conterra' solo i fogli Sheet1 e Sheet2. Non ho capito se Sheet2 e' un foglio di prova o se va processato come tutti gli altri; io l' ho tralasciato.
--ognuno dei file mono-foglio viene aperto, si avvia il Risolutore, si Salva e si chiude
-completata questa fase ognuno dei file mono-fogli viene aperto e il suo foglio viene copiato nel file K nella posizione originale
-il file K viene salvato e chiuso e si passa al successivo file tipo K
Questo processo richiede che il primo foglio del file K si chiami SheetXx (la parte obbligatoria e' "Sheet"), cosa che e' compatibile con i file che hai pubblicato.
Ogni file richiedera' numerosi minuti prima del suo completamento; fai quindi un primo collaudo con pochi file e vedi poi come procedere.

Comunque prima di procedere e' obbligatorio salvare una copia (meglio due...) di tutti i tuoi file per un eventuale ripristino.

Il codice della macro:
Codice: Seleziona tutto
Sub SpitNSolve()
'
Dim mySheets(1 To 50) As String, myPath As String, FName As String
Dim J As Long, myTipo, JJ As Long, KK As Long, LL As Long, WSh
Dim myFiles(1 To 50) As String, mySubDir As String, myScrName As String, CKFile As String

myTipo = Array("K", "C")    '<<< Tipi di file esistenti; NON TOCCARE
mySubDir = "work"       '<<< La subdirectory in cui saranno salvati i "1 sheet files"
'
'scegli la directory in cui sono i file
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Title = "..Seleziona la directory contenente i file da unire..."
    .ButtonName = "Confirm"
    .InitialView = msoFileDialogViewProperties
    .InitialFileName = ""
    .Show
    If .SelectedItems.Count < 1 Then
        MsgBox ("Nessuna selezione; aborted")
        Exit Sub
    End If
    myPath = .SelectedItems(1)
End With
'compila lista worksheets
FName = Dir(myPath & "\K*.xlsx")
Workbooks.Open myPath & "\" & FName, 0
For Each WSh In ActiveWorkbook.Worksheets
DoEvents
    J = J + 1
    mySheets(J) = WSh.Name
Next WSh
ActiveWorkbook.Close savechanges:=False
'
'avvia "scomposizione"
FName = Dir(myPath & "\" & myTipo(LBound(myTipo)) & "*.xlsx")
While FName <> ""
    Workbooks.Open myPath & "\" & FName, 0
    CKFile = ActiveWorkbook.Name            '???
'splitta in N file
    For JJ = 1 To UBound(mySheets)
        Windows(CKFile).Activate
        myFiles(JJ) = ""
        DoEvents
        If mySheets(JJ) <> "" And (UCase(Left(mySheets(JJ), 5)) <> "SHEET") Then
            Sheets(mySheets(JJ)).Move
            myScrName = (myPath & "\" & mySubDir & "\" & Format(JJ, "00") & ".xlsx")
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=myScrName
            Application.DisplayAlerts = True
            ActiveWorkbook.Close savechanges:=False
            myFiles(JJ) = myScrName
            Windows(CKFile).Activate
        End If
    Next JJ
'Resolve sui singoli file...
    For JJ = 1 To UBound(myFiles)
    DoEvents
        If myFiles(JJ) <> "" Then
            Workbooks.Open myFiles(JJ), 0
            Call ssSolve2
            ActiveWorkbook.Close savechanges:=True
        End If
    Next JJ
'Riunisci i singoli files in K
    For JJ = 1 To UBound(myFiles)
    DoEvents
        If myFiles(JJ) <> "" Then
            Workbooks.Open myFiles(JJ), 0
            myCsc = ActiveWorkbook.Name
            Application.DisplayAlerts = False
            Sheets(1).Copy after:=Workbooks(CKFile).Sheets(JJ - 1)
            Workbooks(myCsc).Close savechanges:=True
            Application.DisplayAlerts = True
        End If
    Next JJ
    Workbooks(CKFile).Save
    Workbooks(CKFile).Close savechanges:=True
    FName = Dir()
Wend
MsgBox ("Completato...")
'
End Sub


Sub ssSolve2()
'
Application.Run "SolverReset"
    Application.Run "SolverOk", "$E$1", 2, 0, "$B$8:$GS$8", 1, "GRG Nonlinear"
    Application.Run "SolverSolve", True
'    SolverSolve UserFinish:=True
End Sub

Io l' ho aggiunta nel file Tables.xlsm.
Completato questo processo si potra' rieseguire la Sub forTeo2 gia' presente in Tables.xlsm

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Automatizzare risolutore excel per più file/fogli

Postdi TeUzZz89 » 16/05/13 02:50

Non so davvero come ringraziarti!! la sto provando ora e sta funzionando alla grande!!! l'unica cosa è che comunque rimangono aperti i l file K e il file tables mentre il risolutore è in funzione e forse, come dicevamo prima, questo "rallenta" un po il calcolo, forse perche ho avviato la macro da file tables? però va benissimo così, davvero ti ringrazio tanto per la tua pazienza e disponibilità! Il minimo che posso fare è inserirti nei ringraziamenti per la mia tesi! :) ti terrò aggiornato ;)
TeUzZz89
Utente Junior
 
Post: 20
Iscritto il: 10/05/13 03:48

Re: Automatizzare risolutore excel per più file/fogli

Postdi TeUzZz89 » 16/05/13 09:26

Mi sono dimenticato che in alcuni file K avevo inserito un foglio ARindustries in cui ho messo come i dati in input per tutti gli altri fogli ed è inserito dopo sheet1 e sheet2, solo che forse nei file di esempio che ti avevo mandato non c'era. Dove devo inserire di "ignorare" anche questo foglio come fa con sheet1 e sheet2?
E poi un'ultima domanda, ma quando avvio la macro devo avviare solo SpitNSolve o anche ssSolve2 (o lo fa in automatico comunque) ? Graziee mille!!! :)
TeUzZz89
Utente Junior
 
Post: 20
Iscritto il: 10/05/13 03:48

Re: Automatizzare risolutore excel per più file/fogli

Postdi Anthony47 » 16/05/13 15:07

Tutto lo sviluppo e' partito da file tutti uguali e una tabella (in Tables) da popolare in cui le intestazioni non erano uguali ai nomi dei fogli,
Per questo, per garantire che il posizionamento dei dati in Tables fosse costante, la prima macro (Sub forTeo2) lavora creando un elenco di fogli e usando quella lista su tutti i file successivi. Se alcuni file hanno dei fogli aggiuntivi questi vengono semplicemente ignorati.
La seconda macro (Sub SpitNSolve) ha replicato lo stesso concetto dell' elenco dei fogli: solo i fogli censiti inizialmente vengono poi "lavorati" sui singoli K files (enucleazione, Risoluzione, ricomposizione in K).
Il risultato e' quindi che, in presenza di file che contengono Fogli aggiuntivi:
-la Sub SpitNSolve li lascia sul file K e non li processa separatamente; quindi: (1)maggiore lentezza nell' esecuzione del Risolutore sui file enucleati dal K file (se questi fogli contengono anche loro delle aree analizzate dal risolutore) e (2) il Risolutore non e' stato eseguito su questi fogli che sono rimasti sul K file
-la Sub forTeo2 non estrarra' i dati da questi fogli aggiuntivi per posizionarli nella tabella di Tables.xlsm

Quindi eventuali fogli spuri (cioe' non comuni a tutti i file, tipo C e tipo K) vengono semplicemente ignorati dalle macro sviluppate; potrebbero leggermente rallentare il lavoro di SpitNSolve (sui file che contengono fogli spuri).

TUTTAVIA e' opportuno fare una mdifica nelle macro: infatti partendo dal presupposto che i file eranu tutti uguali io l' elenco dei fogli lo creo su un file preso a caso... Quindi c' e' il rischio che l' elenco venga costruito su un file anomalo, con conseguenti errori nelle fasi successive.

Per rimediare a cio:
-crea un file "master" che contiene solo i fogli comuni (parti da un file tipo K standard, salvalo col nome ZCZC.xlsx nella stessa directory in cui sono localizzati tutti i file K e C (ed e' presente la directory "work").
Modifica la riga marcata '<<<*** presente sia in SpitNSolve che forTeo2
Codice: Seleziona tutto
'compila lista worksheets
FName = Dir(myPath & "\K*.xlsx")  '<<<***
Modificala (in ambedue le macro) in
Codice: Seleziona tutto
FName = Dir(myPath & "\ZCZC.xlsx")  '<<<***


Andando alle "penultime" domande:
-il file K rimane aperto per scelta mentre i singoli fogli vengono elaborati, in attesa di "ricongiungersi" con loro.
-Tables.xlsm non rallenta l' esecuzione del Risolutore
-la Sub ssSolve2 non va lanciata, ma viene richiamata all' interno di SpitNSolve

Ho risposto im modo indiretto e articolato alle domande perche' non e' un gioco di Si e No, spero di non averti confuso oltre le mie intenzioni...

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Automatizzare risolutore excel per più file/fogli

Postdi TeUzZz89 » 18/05/13 04:42

Ciao! scusa se rispondo solo ora! no figurati! anzi grazie mille ancora! ho quasi finito con tutti questi maledetti files! ;)
Grazie mille Anthony47!! ;)
TeUzZz89
Utente Junior
 
Post: 20
Iscritto il: 10/05/13 03:48

Re: Automatizzare risolutore excel per più file/fogli

Postdi TeUzZz89 » 25/05/13 05:23

Ciao! riapro questa discussione! il mio professore ha avuto la bella idea di aumentarmi il carico di lavoro con dati che stava analizzando lui e che ora devo finire! per alcuni file è gia tutto completo il calcolo, ma lui non ha utilizzato "file K" come me, bensì ha 38 file diversi per singolo annuncio ( 1 file per settore industriale), mentre nei miei file K c'erano 38 sheets tutti inclusi in 1 file; in più per alcuni file di questi devo completare anche il calcolo con il risolutore. Quindi la mia richiesta è se sia possibile avere due macro da usare all'occorrenza per l'una o l'altra situazione:

-1) una macro che semplicemente mi unisca diversi file in unico file (il mio prof non ha fatto un unico file con diversi sheets, ma un file diverso per ogni settore industriale, quindi per es. 1 file per banks, 1 file per beverage).

-2) una macro che avvii automaticamente il risolutore tra diversi file (risolutore per 1file, salva chiudi, risolutore per 2 file,...) e poi in pratica applicare la macro precedente per creare un unico file "stile K".

Molto probabilmente queste macro sono ricavabili da quella che mi avevi gentilmente mostrato la volta scorsa, ma non sono per niente esperto di VB e non saprei nemmeno come "ritagliare" la porzione di codice giusta!

Grazie mille come sempre per l'aiuto e disponibilità!!
TeUzZz89
Utente Junior
 
Post: 20
Iscritto il: 10/05/13 03:48

Re: Automatizzare risolutore excel per più file/fogli

Postdi Anthony47 » 26/05/13 01:29

Pero' queste sono "applicazioni complete", mentre il forum ha l' obiettivo di fornire suggerimenti e spunti (salvo i casi piu' semplici).
Detto cio', la macro che passa da N file a 1 file di N fogli si puo' ottenere partendo da una macro autoregistrata:
-creati il file che funzionera' da "coaugulante", cioe' che importera' i fogli dagli altri file (spero che ce ne sia 1 solo). Guardando i file che hai postato immagino che conterra' un foglio Sheet1 e uno Sheet2.
-chiamalo rassembl.xlsm
-metti tutti i file da assemplare in una directory, che contenga solo quei file.
-apri rassembl.xlsm
-avvia il registratore di macro e registra una macro mentre diligentemente:
--apri il primo file, es banks.xlsx, seleziona il primo foglio, "copialo" nel tuo rassembl. Per questo userai: tab Home /gruppo Formato /Formato, Sposta o copia foglio; spunta "Crea una copia", scegli sposta "Alla cartella"=rassembl e "(sposta alla fine)"; Ok
--torna al file da cui stai importando, chiudilo senza salvare.
-salva il file con nome tipo K30_2009_03_03.xlsm
-interrompi quindi la registrazione macro
Si tratta ora di creare un loop che ripeta queste istruzioni su tutti i file presenti in directory; se non riesci a farlo autonomamente pubblica il codice ottenuto e ti aiuteremo in questa operazione.

Non starei a sviluppare una macro che fa girare il risolutore sui singoli file, perche' se non sbaglio ne hai gia' una che fa la stessa cosa smembrando e poi ricostruendo un file tipo K, quindi potrai usare quella macro sul file tipo K creato partendo dal file rassembl.xlsm

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Automatizzare risolutore excel per più file/fogli

Postdi TeUzZz89 » 26/05/13 04:29

Grazie mille! lo so mi stai dando un grande aiuto! il fatto è che io non saprei da dove cominciare e senza di voi penso che sarei ancora a svolgere a mano tante operazioni che si possono fare in meno tempo. Comunque questo è il codice che mi viene:
Codice: Seleziona tutto

Sub Macro1()
'
' Macro1 Macro
'

'
    Application.WindowState = xlMinimized
    Application.WindowState = xlNormal
    Sheets("Automobiles & Parts").Select
    Sheets("Automobiles & Parts").Copy After:=Workbooks("rassembl.xlsm").Sheets(1 _
        )
    Windows("Automobiles & Parts.xls").Activate
    ActiveWindow.Close
    Application.WindowState = xlMinimized
    Application.WindowState = xlNormal
    ChDir "C:\Users\Teo\Desktop"
    ActiveWorkbook.SaveAs Filename:="C:\Users\Teo\Desktop\K30_2009_03_03.xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub



Cosa bisogna scrivere per mettere in loop questa operazione (e in generale qualunque operazione) ?
TeUzZz89
Utente Junior
 
Post: 20
Iscritto il: 10/05/13 03:48

Re: Automatizzare risolutore excel per più file/fogli

Postdi Anthony47 » 27/05/13 00:37

Non hai seguito diligentemente le istruzioni, infatti manca l' apertura del file; non sapendo la directory da cui prelevare riciclo quindi il codice che te la fa scegliere.
Il codice risultante e':
Codice: Seleziona tutto
Sub zzuet()
'scegli la directory in cui sono i file
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Title = "..Seleziona la directory contenente i file da assemblare..."
    .ButtonName = "Confirm"
    .InitialView = msoFileDialogViewProperties
    .InitialFileName = ""
    .Show
    If .SelectedItems.Count < 1 Then
        MsgBox ("Nessuna selezione; aborted")
        Exit Sub
    End If
    myPath = .SelectedItems(1)
End With
'compila lista worksheets
FName = Dir(myPath & "\*.xls")
While FName <> ""
    Workbooks.Open myPath & "\" & FName, 0
    For Each Wsh In ActiveWorkbook.Worksheets
        If UCase(Left(Wsh.Name, 5)) <> "SHEET" Then
            Wsh.Copy After:=Workbooks("rassembl.xlsm").Sheets(Workbooks("rassembl.xlsm").Worksheets.Count)
        End If
    Next Wsh
    FName.Activate
    ActiveWindow.Close Savechanges:=False
        FName = Dir()
Wend
MsgBox ("Completato... & vbCrLf" _
    & "SALVARE A MANO IL FILE ASSEMBLATO CON IL NOME CORRETTO")
'
End Sub

Da quello che dici e' evidente che gli N file hanno piu' fogli; la suddetta macro li copia tutti eccetto quelli che cominciano con "sheet". Se vuoi copiarli invece proprio tutti modifica nella riga
If UCase(Left(Wsh.Name, 5)) <> "SHEET" Then
la scritta SHEET in ZZ.

Prova con pochi file, se il risultato e' ok allora completa il lavoro (lavorando in una directory contenente solo i file non ancora assemblati nel file rassembl.xlsm.
Quando e' completo, salva il file con il nome che ti serve (File /Save as), lasciando rassembl.xlsm come "modello" per il lavoro successivo.
E non dimenticare due copie di backup dei tuoi dati prima di cominciare.

Ciao.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Automatizzare risolutore excel per più file/fogli

Postdi TeUzZz89 » 31/05/13 15:25

Ciao! ho provato più volte, ma una volta creato il file rassemb.xlsm quando avvio la macro mi compare questo errore:
Errore di run-time '424': necessario oggetto
E se clicco su debug mi evidenzia questa linea del codice:
FName.Activate

Cosa sbaglio?
Grazie per la pazienza!!
TeUzZz89
Utente Junior
 
Post: 20
Iscritto il: 10/05/13 03:48

Re: Automatizzare risolutore excel per più file/fogli

Postdi Anthony47 » 01/06/13 12:04

Grazie per la pazienza!!
Ma la pazienza non e' tanta da crearmi un ambiente di prova ad hoc; vedi se puoi pubblicare un .zip che contiene un tot di file da assemblare...

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Automatizzare risolutore excel per più file/fogli

Postdi TeUzZz89 » 02/06/13 05:29

Ah scusa!
questo è il file zip: http://rapidshare.com/files/3185784723/prova_unire.rar
Grazie!

Ciao
TeUzZz89
Utente Junior
 
Post: 20
Iscritto il: 10/05/13 03:48

Re: Automatizzare risolutore excel per più file/fogli

Postdi Anthony47 » 02/06/13 12:08

Modifica l' istruzione che va in errore in
Codice: Seleziona tutto
Workbooks(FName).Activate

Modifica anche l' istruzione del MsgBox finale:
Codice: Seleziona tutto
    MsgBox ("Completato... " & vbCrLf _
        & "SALVARE A MANO IL FILE ASSEMBLATO CON IL NOME CORRETTO")

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Automatizzare risolutore excel per più file/fogli

Postdi TeUzZz89 » 02/06/13 16:51

Grazie mille! ora funziona :)
TeUzZz89
Utente Junior
 
Post: 20
Iscritto il: 10/05/13 03:48


Torna a Applicazioni Office Windows


Topic correlati a "Automatizzare risolutore excel per più file/fogli":


Chi c’è in linea

Visitano il forum: Nessuno e 21 ospiti