macro vba eccessivamente lunga

Hai un problema con Excel?

Nuova discussione

macro vba eccessivamente lunga
di vitruvio (utente non iscritto) data: 05/09/2012 15:58:59
ciao a tutti,
utlizzo questa macro per alcuni report ma vorrei renderla piu sintetica, qualcuno puo darmi una mano?
grazie..

Sub macro_test()



Dim iSheets As Integer
iSheets = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 44
Workbooks.Add
Application.SheetsInNewWorkbook = iSheets
Sheets("foglio1").Name = "sett_rep_italia"
Sheets("foglio2").Name = "114"
Sheets("foglio3").Name = "118"
Sheets("foglio4").Name = "119"
Sheets("foglio5").Name = "120"
Sheets("foglio6").Name = "121"
Sheets("foglio7").Name = "122"
Sheets("foglio8").Name = "124"
Sheets("foglio9").Name = "125"
Sheets("foglio10").Name = "129"
Sheets("foglio11").Name = "115"
Sheets("foglio13").Name = "132"
Sheets("foglio14").Name = "133"
Sheets("foglio15").Name = "134"
Sheets("foglio16").Name = "135"
Sheets("foglio17").Name = "136"
Sheets("foglio18").Name = "137"
Sheets("foglio19").Name = "139"
Sheets("foglio20").Name = "140"
Sheets("foglio21").Name = "141"
Sheets("foglio22").Name = "142"
Sheets("foglio23").Name = "143"
Sheets("foglio24").Name = "144"
Sheets("foglio25").Name = "146"
Sheets("foglio26").Name = "147"
Sheets("foglio27").Name = "148"
Sheets("foglio28").Name = "150"
Sheets("foglio29").Name = "151"
Sheets("foglio30").Name = "152"
Sheets("foglio31").Name = "153"
Sheets("foglio32").Name = "154"
Sheets("foglio33").Name = "155"
Sheets("foglio34").Name = "156"
Sheets("foglio35").Name = "157"
Sheets("foglio36").Name = "159"
Sheets("foglio37").Name = "160"
Sheets("foglio38").Name = "161"
Sheets("foglio39").Name = "162"
Sheets("foglio40").Name = "163"
Sheets("foglio41").Name = "170"
Sheets("foglio42").Name = "179"
Sheets("foglio43").Name = "1189"
Sheets("foglio44").Name = "116"

' questa cartella viene salvata come (TIL)

ChDir _
        "\iperrepRep_LOGpublicDocumenti_Controllo_GestioneArchivio_Reporting_2012Tasso_integrazione"
    ActiveWorkbook.SaveAs Filename:= _
        "\iperrepRep_LOGpublicDocumenti_Controllo_GestioneArchivio_Reporting_2012Tasso_integrazioneTIL.xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False


Application.ScreenUpdating = False


' inserisce il valore "agosto" nella cella (L2) del foglio (sett_rep_italia)
' che attiva il cerc_vert che popola  i dati nel foglio che sono recuperati dal db;
' questo foglio (B1;W68) viene poi copiato ed incollato solo valori nel foglio (til) cartella (sett_rep_italia)
' cella (A1) ( questa operazione viene fatta per 1 volta )..

Windows("tasso_integrazione_mese_cumulo_2012.xlsm").Activate
Sheets("sett_rep_italia").Select
Range("L2").Select
ActiveCell.FormulaR1C1 = "Agosto"



Windows("tasso_integrazione_mese_cumulo_2012.xlsm").Activate
Sheets("sett_rep_italia").Select
Range("b1:w68").Select
Selection.Copy
Workbooks("TIL.xls").Activate
Sheets("sett_rep_italia").Select
Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("a:a").Select
    Selection.ColumnWidth = 4
    Columns("b:b").Select
    Selection.ColumnWidth = 28
    Columns("c:t").Select
    Selection.ColumnWidth = 11



' inserisce il valore "alimentari salati" nella cella (C2) del foglio (riep_funz_prodotti)
' che attiva il cerc_vert che popola  i dati nel foglio che sono recuperati dal db;
' questo foglio (B1;U71) viene poi copiato ed incollato solo valori nel foglio (til_febbraio) cartella (140)
' cella (A1) ( questa operazione viene fatta per 42 volte )..



Windows("tasso_integrazione_mese_cumulo_2012.xlsm").Activate
Sheets("Riep_funz_prod").Select
Range("c2").Select
ActiveCell.FormulaR1C1 = "alimentari salati"
Range("b1:u71").Select
Selection.Copy
Workbooks("TIL.xls").Activate
Sheets("140").Select
Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Columns("a:a").Select
    Selection.ColumnWidth = 12.14
    Columns("b:b").Select
    Selection.ColumnWidth = 27.43
    Columns("c:t").Select
    Selection.ColumnWidth = 11

Windows("tasso_integrazione_mese_cumulo_2012.xlsm").Activate
Sheets("Riep_funz_prod").Select
Range("c2").Select
ActiveCell.FormulaR1C1 = "alimentari dolci"
Range("b1:u71").Select
Selection.Copy
Workbooks("TIL.xls").Activate
Sheets("141").Select
Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Selection.ColumnWidth = 12.14
    Columns("b:b").Select
    Selection.ColumnWidth = 27.43
    Columns("c:t").Select
    Selection.ColumnWidth = 11


' questa cartella viene salvata come (TIL)

 
 ChDir _
        "\iperrepRep_LOGpublicDocumenti_Controllo_GestioneArchivio_Reporting_2012Tasso_integrazione"
    ActiveWorkbook.SaveAs Filename:= _
        "\iperrepRep_LOGpublicDocumenti_Controllo_GestioneArchivio_Reporting_2012Tasso_integrazioneTIL.xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False


Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Aggiornamento dati completato"

End Sub

di Vecchio Frac data: 05/09/2012 17:58:32
Qualche limatura si può fare, ad esempio: non serve ChDir se usi SaveAs; con .Copy puoi evitare di attivare la destinazione e fare tutto in un solo passaggio; in generale puoi utilizzare sempre i riferimenti sul posto senza dover prima fare .Select per eseguire un'operazione; per rinominare i fogli puoi appoggiarti ad un foglio nascosto o a un file di testo e prelevare da lì i nuovi nomi dei file (o meglio ancora se c'è sotto un algoritmo per generare i nomi dei fogli è meglio usare quello).
Facendo una stima a occhio (non ho ancora provato) ma forse riusciamo a ridurre il codice di una ventina di righe.
Quanto all'efficienza, c'è poco da fare... hai giustamente messo ScreenUpdating, ma per fare meglio di così forse occorrono più informazioni sullo scopo e l'utilizzo del file (e magari anche della verione di Excel utilizzata... nesuno lo dice mai ^_^)

di Vecchio Frac data: 07/09/2012 09:05:31
Ho fatto alcune modifiche, soprattutto abbreviando i riferimenti ai range.
Non ho trovato una logica dietro i nomi dei 44 Sheets da aggiungere al nuovo Workbook (TIL), quindi non c'è molto che si possa fare (la soluzione con Choose è l'unica che mi è venuta in mente rispetto alla concisione del codice).
Non ho occasione di fare la prova, vedi tu se tutto fila come dovrebbe :)

edit: nella versione da me postata qualche giorno fa c'era un refuso, ho corretto.

Option Explicit

Sub macro_test()
Dim i As Integer, j As Integer
    
    Application.ScreenUpdating = False
    
    Workbooks.Add
    i = 44 - Application.SheetsInNewWorkbook
    Sheets.Add Count:=i
    
    For j = 1 To 44
        Sheets("foglio" & j).Name = Choose(j, "sett_rep_italia", "114", "118", "119", "120", "121", "122", "124", _
            "125", "129", "115", "132", "133", "134", "135", "136", "137", "139", "140", "141", "142", "143", "144", _
            "146", "147", "148", "150", "151", "152", "153", "154", "155", "156", "157", "159", "160", "161", "162", _
            "163", "170", "179", "1189", "116")
    Next
    
    ' questa cartella viene salvata come (TIL)
    ActiveWorkbook.SaveAs Filename:="\iperrepRep_LOGpublicDocumenti_Controllo_GestioneArchivio_Reporting_2012Tasso_integrazioneTIL.xls"
    
    ' inserisce il valore "agosto" nella cella (L2) del foglio (sett_rep_italia)
    ' che attiva il cerc_vert che popola  i dati nel foglio che sono recuperati dal db;
    ' questo foglio (B1:W68) viene poi copiato ed incollato solo valori nel foglio (til) cartella (sett_rep_italia)
    ' cella (A1) ( questa operazione viene fatta per 1 volta )..
    
    Workbooks("tasso_integrazione_mese_cumulo_2012").Activate
    Sheets("sett_rep_italia").[L2] = "Agosto"
    Sheets("sett_rep_italia").[B1:W68].Copy
    
    With Workbooks("TIL").Sheets("sett_rep_italia")
        .[A1].PasteSpecial Paste:=xlPasteValues
        .[A1].PasteSpecial Paste:=xlPasteFormats
        
        .[A:A].ColumnWidth = 4
        .[B:B].ColumnWidth = 28
        .[C:T].ColumnWidth = 11
    End With
    
    
    ' inserisce il valore "alimentari salati" nella cella (C2) del foglio (riep_funz_prodotti)
    ' che attiva il cerc_vert che popola  i dati nel foglio che sono recuperati dal db;
    ' questo foglio (B1;U71) viene poi copiato ed incollato solo valori nel foglio (til_febbraio) cartella (140)
    ' cella (A1) ( questa operazione viene fatta per 42 volte )..
    
    Sheets("Riep_funz_prod").[C2] = "alimentari salati"
    Sheets("Riep_funz_prod").[B1:U71].Copy
    With Workbooks("TIL").Sheets("140")
        .[A1].PasteSpecial Paste:=xlPasteValues
        .[A1].PasteSpecial Paste:=xlPasteFormats
        
        .[A:A].ColumnWidth = 12.14
        .[B:B].ColumnWidth = 27.43
        .[C:T].ColumnWidth = 11
    End With

    
    Sheets("Riep_funz_prod").[C2] = "alimentari dolci"
    Sheets("Riep_funz_prod").[B1:U71].Copy
    With Workbooks("TIL.xls").Sheets("141")
        .[A1].PasteSpecial Paste:=xlPasteValues
        .[A1].PasteSpecial Paste:=xlPasteFormats
    
        .[A:A].ColumnWidth = 12.14
        .[B:B].ColumnWidth = 27.43
        .[C:T].ColumnWidth = 11
    End With
    
    ' questa cartella viene salvata come (TIL)
    Workbooks("TIL").Save
    
    Application.ScreenUpdating = True
    MsgBox "Aggiornamento dati completato"
End Sub

di vitruvio (utente non iscritto) data: 07/09/2012 15:42:16
Vecchio Frac
ti ringrazio tantissimo, sono riuscito con il tuo prezioso aiuto a sintetizzare il codice, che era troppo ridondante..
grazie ancora ed alla prossima..
vitruvio..
di Vecchio Frac data: 07/09/2012 15:50:39
Allora spuntiamo come risolta questa discussione.

Vuoi Approfondire?