Scrivere una macro da un'altra macro

[karug64]

Salve a tutti.
In un foglio ha del codice all'Interni dell'evento Change.
Avrei la necessità di cancellare il foglio e di inserirne uno nuovo con lo stesso nome (e questo lo so fare...), ma una volta ricreato, ovviamente, non è più presente il codice.

La domanda è : ma c'è modo di scrivere del codice tramite altro codice, in modo da ricreare la situazione precedente?

P.s. L'operazione si rende necessaria perché provvedo a scrivere, cella per cella, molti dati su questo foglio. Il problema è che se lo faccio su un foglio nuovo la routine impiega un po' meno di 30 minuti per scrivere 3800 righe (comprensive di formule, formattazioni condizionali, origine dati, ecc). Se rifaccio la stessa cosa sul foglio già scritto ma del tutto cancellato (senza formattazione, elenchi e quant'altro) i tempi si dilatano in maniera incredibile : stessa operazione (3800 righe) in circa 2 ore e mezza ......

Non capisco il motivo e quindi cerco la strada, magari, più tortuosa.....

Grazie

[karug64]

Edit: 30 minuti circa.... Sono 5 minuti circa....

[Anthony47]

Sei sicuro che i tempi brevi /lunghi corrispondono alle due descrizioni?

Ovviamente sarebbe meglio verificare perche' su un foglio (la cui situazione non mi e' chiara) i tempi siano lunghissimi; hai usato Application.EnableEvents = False all'inizio e = True all' uscita (nb: tutte le possibili uscite)?
Comunque puoi duplicare un foglio usando tasto dx sul tab col suo nome, scegli Sposta o Copia, spunti Crea una copia; poi cancelli (o rinomini l'originale), rinomini la copia e lo predisponi come ti serve.
Se cosi' non risolvi io indagherei per capire da cosa derivano i tempi lunghi.

Ciao

[karug64]

Grazie Anthony.
Ho adottato la soluzione proposta (ero al lavoro proprio per implementarla....).
Per quanto riguarda i tempi ho cercato di capire ma non sino arrivato ad alcuna conclusione.
Il problema non è solo sulla lentezza di compilazione. Infatti una volta scritto per la seconda/terza, ecc volta il foglio è lentissimo anche in esecuzione. Per esempio se in cella b3 ho una formula che controlla il valore di cella b1, al cambiare di valore in b3 ottengo il risultato con un "lag" fastidiosissimo. E non parliamo dello scroll!!!!
Tutte cose che spariscono se creo il foglio su uno vergine....

Proprio non capisco.

P. S. Non mi aspettavo una risposta "diurna"...

[Zer0Kelvin]

Ciao.
Sarebbe meglio poter vedere almeno il codice dell'evento change, da cui possiamo presumere provenga il ritardo...
Inoltre, se tu modifichi il foglio da una routine, sarebbe meglio disabilitare gli eventi ed il ricalcolo ad inizio routine e riabilitarli alla fine. Stessa cosa sarebbe da fare nell'evento Change.

[karug64]

Salve.

La routine presente nell'evento change è questa:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge = Cells.CountLarge Then Exit Sub
If Target.Column = 6 And Target.Count = 1 Then
Application.EnableEvents = False
    If UCase(Target.Value) = "I" Then
        If Target.Offset(0, -1) <> "" Then
            If Left(Target.Offset(0, -1), 5) = "INTERNO: " Then
            Else
                Target.Offset(0, -1) = "INTERNO: " & Replace(Target.Offset(0, -1), "ESTERNO: ", "", , , vbTextCompare)
            End If
        Else
            MsgBox "Nessun inserimento.", vbCritical + vbOKOnly, "Errore"
        End If
    ElseIf UCase(Target.Value) = "E" Then
        If Target.Offset(0, -1) <> "" Then
            If Left(Target.Offset(0, -1), 6) = "ESTERNO" Then
           
            Else
                Target.Offset(0, -1) = "ESTERNO: " & Replace(Target.Offset(0, -1), "INTERNO: ", "", , , vbTextCompare)
            End If
        Else
            MsgBox "Nessun inserimento", vbCritical + vbOKOnly, "Errore"
        End If
    ElseIf Len(Trim(Target.Value)) = 0 Then
        If Len(Trim(Target.Offset(0, -1))) <> 0 Then
            If MsgBox("Non avvalorando il campo, verrà cancellata quello già inserito. Continuare ?", vbQuestion + vbYesNo, "Attenzione") = vbYes Then
                Target.Offset(0, -1) = ""
            End If
         End If
    ElseIf UCase(Target.Value) <> "E" And UCase(Target.Value) <> "I" Then
            MsgBox "La scelta è errata. Inserire 'I' o 'E'. ", vbCritical + vbOKOnly, "Errore"
            Target.Select
    End If
Application.EnableEvents = True
End If
End Sub

che mi è stata fornita proprio su questo forum.

Secondo me il problema non è qui.

Purtroppo non posso postare il programma ( o parte di esso ) essendo infarcito di dati non pubblicabili ( e farne uno stralcio sarebbe impossibile, vista la complessità....).

Il problema è che, se svuoto il foglio con questo codice:

Codice: Seleziona tutto

Dim f As String

f = ""
If fog = "F" Then f = "Foglio_lavoro"

If f <> "" Then

    Sheets(f).Select
    Cells.Select
    Selection.ClearContents
    Selection.Validation.Delete
    Selection.Font.Bold = False
    Selection.Font.Size = 10
    Selection.Font.ColorIndex = nero
    Selection.Interior.ColorIndex = nero
    Selection.Font.Italic = False
       
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
   
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        '.MergeCells = True
    End With
   
    Selection.UnMerge
    Selection.WrapText = False
   
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
   
End If


e poi lo riscrivo con istruzioni del tipo:

Codice: Seleziona tutto

form = ""
                    form = "=SE.ERRORE((ARROTONDA(SOMMA(G" & Trim(Str(interv_iniz)) & ":G" & Trim(Str(interv_fine)) & ")/(I" & Trim(Str(r_progress)) & "-H" & Trim(Str(r_progress)) & ");0));0)"
                    Sheets("Foglio_lavoro").Cells(r_progress, 7).FormulaLocal = form
                    Sheets("Foglio_lavoro").Cells(r_progress, 7).NumberFormat = "General"
                    Sheets("Foglio_lavoro").Cells(r_progress, 7).Font.Size = 9
                    Sheets("Foglio_lavoro").Cells(r_progress, 7).Font.ColorIndex = grigio25
                    Sheets("Foglio_lavoro").Cells(r_progress, 7).Validation.Delete

Codice: Seleziona tutto

r_progress = r_progress + 1
                Sheets("Foglio_lavoro").Cells(r_progress, 3).UnMerge
                Sheets("Foglio_lavoro").Cells(r_progress, 3).ClearContents
                Sheets("Foglio_lavoro").Cells(r_progress, 3).Font.ColorIndex = xlAutomatic
                Sheets("Foglio_lavoro").Cells(r_progress, 3).HorizontalAlignment = xlRight
                Sheets("Foglio_lavoro").Cells(r_progress, 3).Font.Size = 9
                Sheets("Foglio_lavoro").Cells(r_progress, 3).Font.Bold = True
                Sheets("Foglio_lavoro").Cells(r_progress, 3).Font.Italic = False
                Sheets("Foglio_lavoro").Cells(r_progress, 3).WrapText = True
                Sheets("Foglio_lavoro").Cells(r_progress, 3).Value = "Giudizio " + Trim(Str(x))

Codice: Seleziona tutto

Sheets("Foglio_lavoro").Cells(r_progress, 2).UnMerge
                Sheets("Foglio_lavoro").Cells(r_progress, 2).ClearContents
                Sheets("Foglio_lavoro").Cells(r_progress, 2).Value = Sheets("Base_dati").Cells(z, 7).Value
                Sheets("Foglio_lavoro").Cells(r_progress, 2).Font.ColorIndex = xlAutomatic
                Sheets("Foglio_lavoro").Cells(r_progress, 2).HorizontalAlignment = xlLeft
                Sheets("Foglio_lavoro").Cells(r_progress, 2).Font.Size = 9
                Sheets("Foglio_lavoro").Cells(r_progress, 2).Font.Bold = False
                Sheets("Foglio_lavoro").Cells(r_progress, 2).Font.Italic = False
                Call bordo("Foglio_lavoro", "T", "B" & Trim(Str(r_progress)), "B" & Trim(Str(r_progress)), 1, 1, 1, 1)
                ' verifica descrizione
                Sheets("Foglio_lavoro").Cells(r_progress, 3).UnMerge
                Sheets("Foglio_lavoro").Cells(r_progress, 3).ClearContents
                Sheets("Foglio_lavoro").Cells(r_progress, 3).Value = Sheets("Base_dati").Cells(z, 9).Value
                Sheets("Foglio_lavoro").Cells(r_progress, 3).Font.ColorIndex = xlAutomatic
                Sheets("Foglio_lavoro").Cells(r_progress, 3).HorizontalAlignment = xlLeft
                Sheets("Foglio_lavoro").Cells(r_progress, 3).Font.Size = 9
                Sheets("Foglio_lavoro").Cells(r_progress, 3).Font.Bold = False
                Sheets("Foglio_lavoro").Cells(r_progress, 3).Font.Italic = False
                Sheets("Foglio_lavoro").Cells(r_progress, 3).WrapText = True
                Call bordo("Foglio_lavoro", "T", "C" & Trim(Str(r_progress)), "C" & Trim(Str(r_progress)), 1, 1, 1, 1)

già al secondo riempimento la routine diventa sempre più lenta ...... Excel comincia a "non rispondere" per periodi sempre superiori fino, di fatti, a bloccarsi ......

Comunque, ho applicato la soluzione proposta da Anthony che soddisfa le mie esigenze anche se il non dover nascondere, scoprire, duplicare, cancellare i fogli di appoggio non è proprio il massimo ..... ma funziona !!!

Grazie

[Zer0Kelvin]

Fermo restando che se ti funziona così va bene, però:
1)dovresti disabilitare eventi e ricalcolo nella/e routine che preparano il nuovo foglio
2) se devi svuotare completamente il foglio il modo più veloce è

Codice: Seleziona tutto

Sheets(f).Cells.Delete

[Anthony47]

Aggiungo le mie alle considerazioni di Z0K (vedi sopra):

In genere i rallentamenti sono dovuti alle quantita' di formule e alla quantita' di dati che esse vanno a calcolare; nel caso non mi sono fatto nessuna idea di quali formule ci siano nel foglio e quali elaborazioni fa, quindi non mi si accende nessuna lucina...
Non ho capito i pezzetti di macro se servono solo per ricreare il foglio o fanno parte di procedure che vengono eseguite in continuazione.

In modo assolutamente estemporaneo ricordo che una volta mi trovai un foglio lentissimo ed era dovuto all'utilizzo di formule che facevano riferimento a centinaia e centinaia di celle unite; un'altra volta si trattava di codice macro che si addormentava se accedeva alle celle come .Text invece che come .Value

Sempre in modo estemporaneo mi chiedo perche' per azzerare il foglio non ti limiti a fare un Cell.Clear e invece vai a imporre delle formattazioni a tutte le celle del foglio, compreso una convalida di tipo "accetta qualsiasi valore" (che, sia chiaro, non e' pari a "nessuna convalida"). Non so valutare l'impatto di queste formattazioni sulla lentezza successiva, perche' non so quanti dati vengono incollati nelle celle.

Trovo anche curiose alcune parti della Worksheet_Change; ad esempio If Left(Target.Offset(0, -1), 5) = "INTERNO: " non puo' che risultare Falso, e idem il successivo If Left(Target.Offset(0, -1), 6) = "ESTERNO"

Queste cose pero' possono portare a errori logici, non mi pare a loop perditempo.

Ciao

[karug64]

Fermo restando che se ti funziona così va bene, però:
1)dovresti disabilitare eventi e ricalcolo nella/e routine che preparano il nuovo foglio

Ok. Puoi dirmi oltre a questi

Codice: Seleziona tutto

Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlManual

quali altri dovrei disattivare ?

2) se devi svuotare completamente il foglio il modo più veloce è

Codice: Seleziona tutto

Sheets(f).Cells.Delete

Ok. Grazie.
Fatto !!

[karug64]

Ciao Anthony.

Sempre in modo estemporaneo mi chiedo perche' per azzerare il foglio non ti limiti a fare un Cell.Clear e invece vai a imporre delle formattazioni a tutte le celle del foglio .....

semplice ..... Non lo sapevo

Grazie anche a te

[Zer0Kelvin]

Disabilitare eventi ricalcolo e ScreenUpdating in genere è sufficiente; ricordati sempre di riabilitarli a fine routine.
Attento agli errori di RunTime che lascerebbero disabilitati gli eventi, in quanto il codice per ripristinarli non verrebbe eseguito.
Conviene sempre usare una struttura simile

Codice: Seleziona tutto

Sub Esempio()
    On Error GoTo Ripristina
    Application.EnableEvents = False
   
    '.....altro codice
   
Ripristina:
    Application.EnableEvents = True
    'eccetera
End Sub


[karug64]

Ok. Grazie