Condividi:        

Routine troppo grande

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

Routine troppo grande

Postdi Alea » 19/03/12 10:37

Giorno a tutti
sta mattina mi sono imbattuto in questo errore:
Routine troppo grande

Potete consigliarmi come poterlo evitare?
Grazie mille
Alea
Utente Senior
 
Post: 145
Iscritto il: 24/07/06 14:12

Sponsor
 

Re: Routine troppo grande

Postdi Anthony47 » 19/03/12 12:37

Immagino che parli di Vba.
Devi spezzare il codice in due macro, facendo attenzione all' eventuale condivisione di informazioni tra la prima macro e la seconda.
Oppure provi a ottimizzare il codice, eliminando le parti inutili (ad esempio usando Range("A2:A20").Copy Destination:=Sheets("Foglio22").range("A44") invece che Range("A2:A20").Select / Selection.Copy /Sheets("Foglio22"),Select /Range("A44").Select /Selection.Paste /Sheets("Foglio1").select )

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Routine troppo grande

Postdi Alea » 19/03/12 14:29

Domandina: vengono contate anche le righe vuote?
Nel senso che se elimino le righe vuote viene smaltito il codice?
Grazie
Alea
Utente Senior
 
Post: 145
Iscritto il: 24/07/06 14:12

Re: Routine troppo grande

Postdi ricky53 » 19/03/12 15:51

Ciao,
mi hai incuriosito: ma cosa farà la tua ruotine per essere così grande ???

L'ottimizzazione può essere fatta anche individuando parti che possono essere rese comuni e gestite con una macro richiamata quando serve.

Certo sono solo consigli perchè per poter fare una vera ottimizzazione occorre conoscere le necessità dell'applicativo e vedere il codice ma poi sarebbe comunque complesso aiutarti fattivamente. Alle volte si può fare con poche istruzioni ciò che viene fatto con vari passaggi ... i miei sono solo spunti molto generalizzati.
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia

Re: Routine troppo grande

Postdi Alea » 19/03/12 16:03

Vista la curiosità vi posto parte del codice (perchè tutto non me lo fa mettere) così potete dare un'occhiata:
Codice: Seleziona tutto
Public Sub Genera()

'dichiaro le variabili
    Dim lRisposta As Long
    Dim sh As Worksheet
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh3 As Worksheet
    Dim sh4 As Worksheet
    Dim sh5 As Worksheet
    Dim sh6 As Worksheet
    Dim lRiga1 As Long
    Dim lRiga2 As Long
    Dim lRigafine As Long
   
'metto un riferimento ai fogli
With ThisWorkbook
        Set sh1 = .Worksheets("Forniture")
        Set sh2 = .Worksheets("Caltiber")
        Set sh3 = .Worksheets("Nicofer")
        Set sh4 = .Worksheets("Garbin")
        Set sh5 = .Worksheets("Siderurgica")
        Set sh6 = .Worksheets("TipoSfere")
End With

'skrolling del monitor
    Application.ScreenUpdating = False
   
    For Each sh In Worksheets(Array("Caltiber", "Nicofer", "Siderurgica", "Garbin"))
        sh.Range("A4:N100").Delete Shift:=xlUp
    Next
    For Each sh In Worksheets(Array("TipoSfere"))
        sh.Range("A1:N100").Delete Shift:=xlUp
    Next

With sh1
    Range("A3:N3").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:= _
        "=Caltiber", Operator:=xlAnd
    Rows("4:100").Select
    Selection.Copy
    Sheets("Caltiber").Select
    Range("A4").Select
    ActiveSheet.Paste
    Range("A1:N2").Select
    Sheets("Forniture").Select
    ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
    Range("A1:N2").Select
    Application.CutCopyMode = False
End With

With sh1
    ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:="=NicoFer" _
        , Operator:=xlAnd
    Rows("4:100").Select
    Selection.Copy
    Sheets("Nicofer").Select
    Range("A4").Select
    ActiveSheet.Paste
    Range("A1:N2").Select
    Sheets("Forniture").Select
    Range("A1:N2").Select
    ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
    Application.CutCopyMode = False
End With

With sh1
    ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:="=Garbin" _
        , Operator:=xlAnd
    Rows("4:100").Select
    Selection.Copy
    Sheets("Garbin").Select
    Range("A4").Select
    ActiveSheet.Paste
    Range("A1:N2").Select
    Sheets("Forniture").Select
    ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
    Range("A1:N2").Select
    Application.CutCopyMode = False
End With

With sh1
    ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:="=Siderurgica" _
        , Operator:=xlAnd
    Rows("4:100").Select
    Selection.Copy
    Sheets("Siderurgica").Select
    Range("A4").Select
    ActiveSheet.Paste
    Range("A1:N2").Select
    Sheets("Forniture").Select
    ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
    Range("A1:N2").Select
    Application.CutCopyMode = False
End With

'impagino il Foglio Distinte Sfere
With sh6
        With .Range("A:N")
        .Delete Shift:=xlUp
        End With
        With .Range("A:A")
        .Columns.ColumnWidth = 9
        End With
        With .Range("B:B")
        .Columns.ColumnWidth = 25
        End With
        With .Range("C:C")
        .Columns.ColumnWidth = 12
        End With
        With .Range("D:D")
        .Columns.ColumnWidth = 8
        End With
        With .Range("E:E")
        .Columns.ColumnWidth = 12
        End With
        With .Range("F:L")
        .Columns.ColumnWidth = 10
        End With
        With .Range("M:N")
        .Columns.ColumnWidth = 12
        End With
End With

' Sfere SLIM 100/225
With sh1
    lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
    lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
        If lRiga2 < 5 Then lRiga2 = 4

With sh6
    .Range("A" & lRiga2 - 3 & ":N" & lRiga2 - 3).MergeCells = True
        With .Range("A" & lRiga2 - 3 & ":N" & lRiga2 - 3)
            .Value = "FORNITURE COBIAX ANNO 2011 - ORDINATE PER TIPOLOGIA SFERE"
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Font.Bold = True
            .Font.Size = 14
            .HorizontalAlignment = xlCenter
            .Rows.RowHeight = 20#
        End With
End With
       
    'filtro per Sfere Slim 100/225
            Sheets("Forniture").Select
            ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:= _
                "=S-100/225", Operator:=xlAnd
       
             If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
            sh6.Range("A" & lRiga2).CurrentRegion.ClearFormats
With sh6
        .Range("A" & lRiga2 - 1).Value = "Codice"
        .Range("B" & lRiga2 - 1).Value = "Nome Progetto"
        .Range("C" & lRiga2 - 1).Value = "Solaio"
        .Range("D" & lRiga2 - 1).Value = "Sistema"
        .Range("E" & lRiga2 - 1).Value = "Tipologia alleggerimento"
        .Range("F" & lRiga2 - 1).Value = "Nr. Sfere"
        .Range("G" & lRiga2 - 1).Value = "Nr. Gabbie"
        .Range("H" & lRiga2 - 1).Value = "Disegno Modulo"
        .Range("I" & lRiga2 - 1).Value = "Connettori"
        .Range("J" & lRiga2 - 1).Value = "Impresa"
        .Range("K" & lRiga2 - 1).Value = "Produz."
        .Range("L" & lRiga2 - 1).Value = "Relaz. Tecnica"
        .Range("M" & lRiga2 - 1).Value = "Superficie getto [mq]"
        .Range("N" & lRiga2 - 1).Value = "Prefabbric."
            With .Range("A" & lRiga2 - 1 & ":N" & lRiga2 - 1)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
End With
               
'copio/incollo
    .Range("A4:N100" & lRiga1).Copy _
        Destination:=sh6.Range("A" & lRiga2)
       
With sh6
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 & ":F" & lRigafine & ")"
    With .Range("F" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0"" sf"""
        .Font.Color = -16776961
    End With
        .Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 & ":G" & lRigafine & ")"
    With .Range("G" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" g"""
        .Font.Color = -16776961
    End With
        .Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 & ":M" & lRigafine & ")"
    With .Range("M" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" mq"""
        .Font.Color = -16776961
    End With
End With

With sh6
    Call mBordi1(.Range("A" & lRiga2 - 1 & ":N" & lRigafine))
    Call mBordi2(.Range("A" & lRiga2 & ":N" & lRigafine))
End With

        End If
End With
 
'tolgo il filtro nel foglio FILE_txt
    With sh1
        .Range("$A$3:$N$3").AutoFilter Field:=5
    End With


' Sfere SLIM 100/315
With sh1
    lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
    lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
        If lRiga2 < 5 Then lRiga2 = 4
           
    'filtro per Sfere PRO 100/315
            Sheets("Forniture").Select
            ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=S-100/315", _
                Operator:=xlAnd
             
            If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
        .Range("A" & lRiga2 + 3).Value = "Codice"
        .Range("B" & lRiga2 + 3).Value = "Nome Progetto"
        .Range("C" & lRiga2 + 3).Value = "Solaio"
        .Range("D" & lRiga2 + 3).Value = "Sistema"
        .Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
        .Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
        .Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
        .Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
        .Range("I" & lRiga2 + 3).Value = "Connettori"
        .Range("J" & lRiga2 + 3).Value = "Impresa"
        .Range("K" & lRiga2 + 3).Value = "Produz."
        .Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
        .Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
        .Range("N" & lRiga2 + 3).Value = "Prefabbric."
            With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
End With

'copio/incollo
    .Range("A4:N100" & lRiga1).Copy _
        Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
    With .Range("F" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0"" sf"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
    With .Range("G" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" g"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
    With .Range("M" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" mq"""
        .Font.Color = -16776961
    End With
End With

With sh6
    Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
    Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With

        End If
End With
   
'tolgo il filtro nel foglio FILE_txt
    With sh1
        .Range("$A$3:$N$3").AutoFilter Field:=5
    End With


' Sfere SLIM 120/315
With sh1
    lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
    lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
        If lRiga2 < 5 Then lRiga2 = 4
           
    'filtro per Sfere PRO 120/315
            Sheets("Forniture").Select
            ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=S-120/315", _
                Operator:=xlAnd
             
            If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
        .Range("A" & lRiga2 + 3).Value = "Codice"
        .Range("B" & lRiga2 + 3).Value = "Nome Progetto"
        .Range("C" & lRiga2 + 3).Value = "Solaio"
        .Range("D" & lRiga2 + 3).Value = "Sistema"
        .Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
        .Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
        .Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
        .Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
        .Range("I" & lRiga2 + 3).Value = "Connettori"
        .Range("J" & lRiga2 + 3).Value = "Impresa"
        .Range("K" & lRiga2 + 3).Value = "Produz."
        .Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
        .Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
        .Range("N" & lRiga2 + 3).Value = "Prefabbric."
            With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
End With

'copio/incollo
    .Range("A4:N100" & lRiga1).Copy _
        Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
    With .Range("F" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0"" sf"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
    With .Range("G" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" g"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
    With .Range("M" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" mq"""
        .Font.Color = -16776961
    End With
End With

With sh6
    Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
    Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With

        End If
End With
   
'tolgo il filtro nel foglio FILE_txt
    With sh1
        .Range("$A$3:$N$3").AutoFilter Field:=5
    End With


' Sfere SLIM 140/315
With sh1
    lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
    lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
        If lRiga2 < 5 Then lRiga2 = 4
           
    'filtro per Sfere PRO 140/315
            Sheets("Forniture").Select
            ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=S-140/315", _
                Operator:=xlAnd
             
            If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
        .Range("A" & lRiga2 + 3).Value = "Codice"
        .Range("B" & lRiga2 + 3).Value = "Nome Progetto"
        .Range("C" & lRiga2 + 3).Value = "Solaio"
        .Range("D" & lRiga2 + 3).Value = "Sistema"
        .Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
        .Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
        .Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
        .Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
        .Range("I" & lRiga2 + 3).Value = "Connettori"
        .Range("J" & lRiga2 + 3).Value = "Impresa"
        .Range("K" & lRiga2 + 3).Value = "Produz."
        .Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
        .Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
        .Range("N" & lRiga2 + 3).Value = "Prefabbric."
            With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
End With

'copio/incollo
    .Range("A4:N100" & lRiga1).Copy _
        Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
    With .Range("F" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0"" sf"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
    With .Range("G" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" g"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
    With .Range("M" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" mq"""
        .Font.Color = -16776961
    End With
End With

With sh6
    Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
    Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With

        End If
End With
   
'tolgo il filtro nel foglio FILE_txt
    With sh1
        .Range("$A$3:$N$3").AutoFilter Field:=5
    End With
   

' Sfere SLIM 160/315
With sh1
    lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
    lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
        If lRiga2 < 5 Then lRiga2 = 4
           
    'filtro per Sfere PRO 160/315
            Sheets("Forniture").Select
            ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=S-160/315", _
                Operator:=xlAnd
             
            If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
        .Range("A" & lRiga2 + 3).Value = "Codice"
        .Range("B" & lRiga2 + 3).Value = "Nome Progetto"
        .Range("C" & lRiga2 + 3).Value = "Solaio"
        .Range("D" & lRiga2 + 3).Value = "Sistema"
        .Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
        .Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
        .Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
        .Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
        .Range("I" & lRiga2 + 3).Value = "Connettori"
        .Range("J" & lRiga2 + 3).Value = "Impresa"
        .Range("K" & lRiga2 + 3).Value = "Produz."
        .Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
        .Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
        .Range("N" & lRiga2 + 3).Value = "Prefabbric."
            With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
End With

'copio/incollo
    .Range("A4:N100" & lRiga1).Copy _
        Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
    With .Range("F" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0"" sf"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
    With .Range("G" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" g"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
    With .Range("M" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" mq"""
        .Font.Color = -16776961
    End With
End With

With sh6
    Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
    Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With

        End If
End With
   
'tolgo il filtro nel foglio FILE_txt
    With sh1
        .Range("$A$3:$N$3").AutoFilter Field:=5
    End With


' Sfere SLIM 180/315
With sh1
    lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
    lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
        If lRiga2 < 5 Then lRiga2 = 4
           
    'filtro per Sfere PRO 180/315
            Sheets("Forniture").Select
            ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=S-180/315", _
                Operator:=xlAnd
             
            If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
        .Range("A" & lRiga2 + 3).Value = "Codice"
        .Range("B" & lRiga2 + 3).Value = "Nome Progetto"
        .Range("C" & lRiga2 + 3).Value = "Solaio"
        .Range("D" & lRiga2 + 3).Value = "Sistema"
        .Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
        .Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
        .Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
        .Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
        .Range("I" & lRiga2 + 3).Value = "Connettori"
        .Range("J" & lRiga2 + 3).Value = "Impresa"
        .Range("K" & lRiga2 + 3).Value = "Produz."
        .Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
        .Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
        .Range("N" & lRiga2 + 3).Value = "Prefabbric."
            With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
End With

'copio/incollo
    .Range("A4:N100" & lRiga1).Copy _
        Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
    With .Range("F" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0"" sf"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
    With .Range("G" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" g"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
    With .Range("M" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" mq"""
        .Font.Color = -16776961
    End With
End With

With sh6
    Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
    Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With

        End If
End With
   
'tolgo il filtro nel foglio FILE_txt
    With sh1
        .Range("$A$3:$N$3").AutoFilter Field:=5
    End With



'ripristino l'aggiornamento del monitor
Application.ScreenUpdating = True

'Set a Nothing delle variabili oggetto
Set sh = Nothing
Set sh1 = Nothing
Set sh2 = Nothing
Set sh3 = Nothing
Set sh4 = Nothing
Set sh5 = Nothing
Set sh6 = Nothing

End Sub




Penso comunque di aver trovato un "pezzetto" che viene ripetuto parecchie volte ed è questo:
Codice: Seleziona tutto
With sh6
        .Range("A" & lRiga2 + 3).Value = "Codice"
        .Range("B" & lRiga2 + 3).Value = "Nome Progetto"
        .Range("C" & lRiga2 + 3).Value = "Solaio"
        .Range("D" & lRiga2 + 3).Value = "Sistema"
        .Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
        .Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
        .Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
        .Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
        .Range("I" & lRiga2 + 3).Value = "Connettori"
        .Range("J" & lRiga2 + 3).Value = "Impresa"
        .Range("K" & lRiga2 + 3).Value = "Produz."
        .Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
        .Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
        .Range("N" & lRiga2 + 3).Value = "Prefabbric."
            With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
End With

se dovessi mettere al posto di questa parte ad esempio:
Codice: Seleziona tutto
With sh6
call impaginazione
End With


come dovrei scrivere la Sub impaginazione?
Grazie
Alea
Utente Senior
 
Post: 145
Iscritto il: 24/07/06 14:12

Re: Routine troppo grande

Postdi ricky53 » 19/03/12 16:37

Uhm, Uhm ... molte cose andrebbero riviste però ... sul codice al momento una sola domanda perchè utilizzi "With .. End With così tante volte?
In alcuni casi, per come hai scritto il codice, non serve esempio
Codice: Seleziona tutto
With sh1
    Range("A3:N3").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:= _
        "=Caltiber", Operator:=xlAnd
    Rows("4:100").Select
    Selection.Copy
    Sheets("Caltiber").Select
    Range("A4").Select
    ActiveSheet.Paste
    Range("A1:N2").Select
    Sheets("Forniture").Select
    ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
    Range("A1:N2").Select
    Application.CutCopyMode = False
End With

visto che poi selezioni comunque il foglio Caltiber ed eri partito dal foglio "Forniture" ... qui entra IN GIOCO quanto ti ha già scritto Anthony sul Copy/Destination ... per ottimizzare il codice scritto


Passiamo ad altre domande:
I sei fogli hanno struttura diversa? Contengono dati comuni?
In sostanza possono essere uniti in un solo file ?
In questo modo si semplificherebbe molto il codice basterebbe avere una colonna in più per contenere il nome che identifichi la tipologia Forniture, Caltiber, ..., TipoSfere



Per la chiamata: la routine "Impaginazione" avrà lo stesso codice ma dovrà ricevere come parametro la riga ed il nome foglio (o Tipo secondo il mio precedente suggerimento) ecco uno spunto con la struttura attuale a sei fogli
Codice: Seleziona tutto
...
Call Impaginazione(Foglio, Riga)
...


Sub Impaginazione(Sh, lRiga2)
        Sheets(Sh).Range("A" & lRiga2 + 3).Value = "Codice"
        Sheets(Sh).Range("B" & lRiga2 + 3).Value = "Nome Progetto"
        .....
End Sub
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia

Re: Routine troppo grande

Postdi Alea » 19/03/12 16:46

Ciao Ricky
posso allegare il file così puoi dare un'occhiata:
Intanto ti dico che i primi 5 fogli hanno la stessa struttura e il sesto "TipoSfere" è quello con struttura diversa.
Planning_Forniture_2012.xls - 872.5 KB
Nel foglio "Forniture" inserisco tutti i dati; i fogli dal 2 al 5 vengono compilati in base al criterio di colonna N; il sesto viene compilato in base al criterio di colonna E
Alea
Utente Senior
 
Post: 145
Iscritto il: 24/07/06 14:12

Re: Routine troppo grande

Postdi ricky53 » 19/03/12 16:53

Ciao,
scarico il file e ci risentiamo.

Così al volo se 5 fogli sono uguali perchè non unisci quelli unibili?
Potresti avere tre fogli ... ma aspettiamo che veda il file e ne riparliamo.
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia

Re: Routine troppo grande

Postdi Alea » 19/03/12 17:02

4 fogli praticamente sono creati con il nome del proprio prefabbricatore ed inoltre ho una macro che mi salva i singoli fogli in file singoli per poterli spedire al prefabbricatore stesso.
Alea
Utente Senior
 
Post: 145
Iscritto il: 24/07/06 14:12

Re: Routine troppo grande

Postdi ricky53 » 19/03/12 17:34

Ciao,
ho scaricato il tuo file:
1. attenzione hai 3 riferimenti circolari foglio Tiposfere celle F72, G72, M72

2. nel foglio Forniture colonna "G" ci sono formule che dividono per numeri diversi ... ??? controlla ad esempio le celle G25:G29, G34:G37 la cosa vale anche per le altre celle della stessa colonna


Lo guardo e ... mi faccio risentire.
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia

Re: Routine troppo grande

Postdi ricky53 » 19/03/12 18:07

Ciao,
tanto per gradire una piccola ottimizzazione
Codice: Seleziona tutto
'impagino il Foglio Distinte Sfere
   With sh6
        .Range("A:N").Delete Shift:=xlUp
        .Range("A:A").Columns.ColumnWidth = 9
        .Range("B:B").Columns.ColumnWidth = 25
        .Range("C:C, E:E,M:N").Columns.ColumnWidth = 12 '  Qui ho unito colonne con stessa larghezza
        .Range("D:D").Columns.ColumnWidth = 8
        .Range("F:L").Columns.ColumnWidth = 10
   End With


Cerca, nel resto della tua macro, altre situazioni simili e prosegui tu.
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia

Re: Routine troppo grande

Postdi ricky53 » 19/03/12 18:24

Ciao,
ma che caspita gli fai fare a questa macro !!!!

Sei proprio sicuro che ti occorra tutto quello che hai scritto ... mi sembra che molte cose siano ripetute ...

Comunque NON TI OFFENDERE ma software presentato in modo peggiore non l'avevo mai visto

INDENTA, INDENTA e INDENTA altrimenti non si capisce quando inizia un "If" o un "With"
ad esempio, non essendoci l'indentazione giusta, ho fatiato a trovare la chiusura del seguente If
Codice: Seleziona tutto
If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then   


Non ho il tempo (e la voglia) di continuare a sistemare l'indentazione se la fai tu allora posso riprovarci ...


Ti invio in pezzo che ho fatto per farti capire come va fatto per renderlo leggibile.
Codice: Seleziona tutto
Public Sub Genera()
'dichiaro le variabili
    Dim lRisposta As Long
    Dim sh As Worksheet
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh3 As Worksheet
    Dim sh4 As Worksheet
    Dim sh5 As Worksheet
    Dim sh6 As Worksheet
    Dim lRiga1 As Long
    Dim lRiga2 As Long
    Dim lRigafine As Long
'metto un riferimento ai fogli
    With ThisWorkbook
        Set sh1 = .Worksheets("Forniture")
        Set sh2 = .Worksheets("Caltiber")
        Set sh3 = .Worksheets("Nicofer")
        Set sh4 = .Worksheets("Garbin")
        Set sh5 = .Worksheets("Siderurgica")
        Set sh6 = .Worksheets("TipoSfere")
    End With
'skrolling del monitor
    Application.ScreenUpdating = False
    For Each sh In Worksheets(Array("Caltiber", "Nicofer", "Siderurgica", "Garbin"))
        sh.Range("A4:N100").Delete Shift:=xlUp
    Next
    For Each sh In Worksheets(Array("TipoSfere"))
        sh.Range("A1:N100").Delete Shift:=xlUp
    Next
    With sh1
        Range("A3:N3").Select
        Selection.AutoFilter
        ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:= _
            "=Caltiber", Operator:=xlAnd
        Rows("4:100").Select
        Selection.Copy
        Sheets("Caltiber").Select
        Range("A4").Select
        ActiveSheet.Paste
        Range("A1:N2").Select
        Sheets("Forniture").Select
        ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
        Range("A1:N2").Select
        Application.CutCopyMode = False
    End With
    With sh1
        ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:="=NicoFer" _
            , Operator:=xlAnd
        Rows("4:100").Select
        Selection.Copy
        Sheets("Nicofer").Select
        Range("A4").Select
        ActiveSheet.Paste
        Range("A1:N2").Select
        Sheets("Forniture").Select
        Range("A1:N2").Select
        ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
        Application.CutCopyMode = False
    End With
    With sh1
        ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:="=Garbin" _
            , Operator:=xlAnd
        Rows("4:100").Select
        Selection.Copy
        Sheets("Garbin").Select
        Range("A4").Select
        ActiveSheet.Paste
        Range("A1:N2").Select
        Sheets("Forniture").Select
        ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
        Range("A1:N2").Select
        Application.CutCopyMode = False
    End With
    With sh1
        ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14, Criteria1:="=Siderurgica" _
            , Operator:=xlAnd
        Rows("4:100").Select
        Selection.Copy
        Sheets("Siderurgica").Select
        Range("A4").Select
        ActiveSheet.Paste
        Range("A1:N2").Select
        Sheets("Forniture").Select
        ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=14
        Range("A1:N2").Select
        Application.CutCopyMode = False
    End With
'impagino il Foglio Distinte Sfere
    With sh6
        .Range("A:N").Delete Shift:=xlUp
        .Range("A:A").Columns.ColumnWidth = 9
        .Range("B:B").Columns.ColumnWidth = 25
        .Range("C:C, E:E,M:N").Columns.ColumnWidth = 12
        .Range("D:D").Columns.ColumnWidth = 8
        .Range("F:L").Columns.ColumnWidth = 10
    End With
' Sfere SLIM 100/225
    With sh1
        lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
        lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
        If lRiga2 < 5 Then lRiga2 = 4
        With sh6
            .Range("A" & lRiga2 - 3 & ":N" & lRiga2 - 3).MergeCells = True
            With .Range("A" & lRiga2 - 3 & ":N" & lRiga2 - 3)
                .Value = "FORNITURE COBIAX ANNO 2011 - ORDINATE PER TIPOLOGIA SFERE"
                .VerticalAlignment = xlCenter
                .WrapText = True
                .Font.Bold = True
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .Rows.RowHeight = 20#
            End With
        End With
    'filtro per Sfere Slim 100/225
        Sheets("Forniture").Select
        ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:= _
            "=S-100/225", Operator:=xlAnd
        If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
            sh6.Range("A" & lRiga2).CurrentRegion.ClearFormats
            With sh6
                .Range("A" & lRiga2 - 1).Value = "Codice"
                .Range("B" & lRiga2 - 1).Value = "Nome Progetto"
                .Range("C" & lRiga2 - 1).Value = "Solaio"
                .Range("D" & lRiga2 - 1).Value = "Sistema"
                .Range("E" & lRiga2 - 1).Value = "Tipologia alleggerimento"
                .Range("F" & lRiga2 - 1).Value = "Nr. Sfere"
                .Range("G" & lRiga2 - 1).Value = "Nr. Gabbie"
                .Range("H" & lRiga2 - 1).Value = "Disegno Modulo"
                .Range("I" & lRiga2 - 1).Value = "Connettori"
                .Range("J" & lRiga2 - 1).Value = "Impresa"
                .Range("K" & lRiga2 - 1).Value = "Produz."
                .Range("L" & lRiga2 - 1).Value = "Relaz. Tecnica"
                .Range("M" & lRiga2 - 1).Value = "Superficie getto [mq]"
                .Range("N" & lRiga2 - 1).Value = "Prefabbric."
                With .Range("A" & lRiga2 - 1 & ":N" & lRiga2 - 1)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlTop
                    .WrapText = True
                End With
            End With
'copio/incollo
            .Range("A4:N100" & lRiga1).Copy _
                Destination:=sh6.Range("A" & lRiga2)
            With sh6
                lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
                .Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 & ":F" & lRigafine & ")"
                With .Range("F" & lRigafine + 1)
                    .Font.Bold = True
                    .NumberFormat = "0"" sf"""
                    .Font.Color = -16776961
                End With
                .Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 & ":G" & lRigafine & ")"
                With .Range("G" & lRigafine + 1)
                    .Font.Bold = True
                    .NumberFormat = "0.00"" g"""
                    .Font.Color = -16776961
                End With
                .Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 & ":M" & lRigafine & ")"
                With .Range("M" & lRigafine + 1)
                    .Font.Bold = True
                    .NumberFormat = "0.00"" mq"""
                    .Font.Color = -16776961
                End With
            End With
            With sh6
                Call mBordi1(.Range("A" & lRiga2 - 1 & ":N" & lRigafine))
                Call mBordi2(.Range("A" & lRiga2 & ":N" & lRigafine))
            End With
        End If
    End With
'tolgo il filtro nel foglio FILE_txt
    With sh1
        .Range("$A$3:$N$3").AutoFilter Field:=5
    End With
' Sfere SLIM 100/315
    With sh1
        lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
        lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
        If lRiga2 < 5 Then lRiga2 = 4
    'filtro per Sfere PRO 100/315
        Sheets("Forniture").Select
        ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=S-100/315", _
            Operator:=xlAnd
        If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
            With sh6
                .Range("A" & lRiga2 + 3).Value = "Codice"
                .Range("B" & lRiga2 + 3).Value = "Nome Progetto"
                .Range("C" & lRiga2 + 3).Value = "Solaio"
                .Range("D" & lRiga2 + 3).Value = "Sistema"
                .Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
                .Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
                .Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
                .Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
                .Range("I" & lRiga2 + 3).Value = "Connettori"
                .Range("J" & lRiga2 + 3).Value = "Impresa"
                .Range("K" & lRiga2 + 3).Value = "Produz."
                .Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
                .Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
                .Range("N" & lRiga2 + 3).Value = "Prefabbric."
                With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlTop
                    .WrapText = True
                End With
            End With
'copio/incollo
            .Range("A4:N100" & lRiga1).Copy _
                Destination:=sh6.Range("A" & lRiga2 + 4)
            With sh6
                lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
                .Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
                With .Range("F" & lRigafine + 1)
                    .Font.Bold = True
                    .NumberFormat = "0"" sf"""
                    .Font.Color = -16776961
                End With
                lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
                .Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
                With .Range("G" & lRigafine + 1)
                    .Font.Bold = True
                    .NumberFormat = "0.00"" g"""
                    .Font.Color = -16776961
                End With
                lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
                .Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
                With .Range("M" & lRigafine + 1)
                    .Font.Bold = True
                    .NumberFormat = "0.00"" mq"""
                    .Font.Color = -16776961
                End With
            End With
            With sh6
                Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
                Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
            End With
        End If
    End With
'tolgo il filtro nel foglio FILE_txt
    With sh1
        .Range("$A$3:$N$3").AutoFilter Field:=5
    End With
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia

Re: Routine troppo grande

Postdi ricky53 » 19/03/12 18:52

Ciao,
ultima cosa e poi per oggi si molla

ho visto che il codice per la sezione Sfere SLIM 100/315 è lo stesso di quello della sezione Sfere SLIM 120/315
l'unica differenza è il criterio con cui filtri la colonna "E" probabilmente andando avanti a leggere il codice si troveranno altre sezioni uguali
Potevi fare un
ciclo For/Next
cambiando i criteri del filtro con un intervallo di appoggio ed il codice sarebbe diventato molto, ma molto ridotto !!!!

Premesso che la tua macro così come è adesso non l'hai mai eseguita !!!
Ma quanto codice hai ripetuto per arrivare a non poterla eseguire ???

Ho cancellato gli ultimi tre gruppi di "Sfere ..." e ... miracolo la macro si AVVIA !!!


A più tardi se sopravviverò ... allo stress avuto a causa della lettura del tuo codice ... Eh,Eh !!!
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia

Re: Routine troppo grande

Postdi Anthony47 » 19/03/12 21:40

Essendo la macro molto "lineare" credo che sia facile spezzarla in due e metterle su due moduli diversi. Probabilmente bastera' ripetere le dichiarazioni e i Set iniziali e poche altre cose.
Questo sempre che il messaggio dipenda dalla lunghezza del codice, perche' quello che hai pubblicato e' abbastanza corto (non ricordo se la max lunghezza e' 32 o 64 kb, ma quello pubblicato e' sui 25kb).

Puoi verificare tagliando, sulla macro che ti da l' errore, un po' di righe in coda (diciamo 30 alla volta, lasciando la struttura sintatticamente corretta; quindi curando If /End If, With /End With, For /Next). Non devi mandarla in esecuzione, basta fare F8 per procedere alla compilazione.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Routine troppo grande

Postdi ricky53 » 20/03/12 00:44

Ciao,
prima leggi quanto ti ha scritto Anthony.


Ecco le mie considerazioni:
i vari gruppi
da Sfere SLIM 100/315 a Sfere SLIM 220/315
da Sfere PRO 180 a Sfere PRO 450
da Sfere ECO 180 a Sfere ECO 360

Non li ho potuti guardare tutti e controllare le varie irghe di codice, però a me sembra che abbiano tutti le stesse istruzioni!!!
Confermi ???

Hai ripetuto più volte i gruppi ed hai modificato le condizioni di filtro ???
Se le due risposte sono “SI” allora si può ottimizzare molto.

Cancellarli tutti e sostituirli con un ciclo For / Next

Prima di proporti qualcosa attendo le tue risposte.
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia

Re: Routine troppo grande

Postdi Anthony47 » 20/03/12 02:21

Alcune precisazioni:
1) L' errore Routine troppo grande si presenta quando "una singola macro" e' piu' lunga di 64 kByte. Non c' entra la lunghezza del "Modulo" (come ho scritto nel post precedente), quindi se si divide il macrone in due macro esse possono rimanere nello stesso Modulo.
2) Sempre nel mio post precedente ho chiesto di verificare se l' errore era proprio di macro troppo lunga. E' una richiesta inutile, basta aprire il file allegato da Alea e constatare che la macro Genera di Modulo1 ha una lunghezza di circa 67 kB
3) Nel post precedente ho scritto che la macro e' "lineare"; non era un giudizio sull' organizzazione del codice (bastano quelli di Ricky :D ) ma la constatazione che la macro si esegue "avanzando in linea retta", cosi' che lo split in due macro (anche da tenere sullo stesso modulo!) risulterebbe abbastanza facile.

Visto che la parte da tagliare (circa 3 kB) e' abbastanza contenuta darei per scontato che ottimizzando il codice si puo' rientrare nei limiti.

Tuttavia il mio suggerimento (non vincolante per nessuno, sia chiaro) rimane quello di spezzare la macro in due:
-perche' se ora si rientra nei 64 kB non e' detto che al prossimo ampliamento non si ritorni sopra la soglia (ma riconosco che i margini di miglioramento sembrano grandi, vista la ripetitivita' delle istruzioni).
-perche' l' utente una macro in questo stile la sa manutenere e arricchire, potrebbe andare in crisi (momentanea) in presenza di codice piu' sofisticato.

Ciao a tutti.

PS per Alea: non perdere i messaggi precedenti a questo
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Routine troppo grande

Postdi Alea » 20/03/12 09:32

Aiutoooooo
sta mattina mi sono trovato a leggere 7 post di file e un pochino mi sono perso. Vediamo se riesco a rispondere alle vostre domande:
Ricky
Sei proprio sicuro che ti occorra tutto quello che hai scritto ... mi sembra che molte cose siano ripetute ...
Comunque NON TI OFFENDERE ma software presentato in modo peggiore non l'avevo mai visto

:lol: vai tranquillissimo è stata una delle prime macro che ho provato a fare
Ricky
Ti invio in pezzo che ho fatto per farti capire come va fatto per renderlo leggibile.

Provvederò il prima possibile a seguire il tuo suggerimento
Ricky
ho visto che il codice per la sezione Sfere SLIM 100/315 è lo stesso di quello della sezione Sfere SLIM 120/315
l'unica differenza è il criterio con cui filtri la colonna "E" probabilmente andando avanti a leggere il codice si troveranno altre sezioni uguali

Ricky
Ecco le mie considerazioni:
i vari gruppi
da Sfere SLIM 100/315 a Sfere SLIM 220/315
da Sfere PRO 180 a Sfere PRO 450
da Sfere ECO 180 a Sfere ECO 360

Non li ho potuti guardare tutti e controllare le varie irghe di codice, però a me sembra che abbiano tutti le stesse istruzioni!!!
Confermi ???

Hai ripetuto più volte i gruppi ed hai modificato le condizioni di filtro ???
Se le due risposte sono “SI” allora si può ottimizzare molto.

praticamente sono tutte uguali. i criteri che ho sono parecchi e sono tutti da impaginare allo stesso modo. Giusto per dire quali sono:
SLIM 100/225
SLIM 100/315
SLIM 120/315
SLIM 140/315
SLIM 160/315
SLIM 180/315
SLIM 200/315
SLIM 220/315
ECO 180
ECO 225
ECO 270
ECO 315
ECO 360
ECO 405
ECO 450
PRO 180 - PRO 180a
PRO 225 - PRO 225a
PRO 270 - PRO 270a
PRO 315 - PRO 315a
PRO 360 - PRO 360a
PRO 405 - PRO 405a
PRO 450 - PRO 450a
Anthony
Essendo la macro molto "lineare" credo che sia facile spezzarla in due e metterle su due moduli diversi. Probabilmente bastera' ripetere le dichiarazioni e i Set iniziali e poche altre cose.

Oggi intanto proverò a spezzarla così da poterla utilizzare.
Poi piano piano dovrò sistemarla per snellirla un pochino :lol:
Grazie mille ad entrambi
Alea
Utente Senior
 
Post: 145
Iscritto il: 24/07/06 14:12

Re: Routine troppo grande

Postdi ricky53 » 20/03/12 13:54

Ciao,
bene.
Prova a spezzarla in due.
Io ti sto per proporre un'ottimizzazione sulla sezioni: al momento sono fuori sede quindi più tardi ti invierò qualcosa.

Vado a memoria perchè al momento non ho il file con me: mi sembra che la SLIM 100/225 sia diversa dalle altre ma è l'unica.
Confermi ???
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia

Re: Routine troppo grande

Postdi Alea » 20/03/12 15:32

Ti confermo che è diversa ma sinceramente non mi ricordo il perchè. Probabilmente perchè copiando da altre macro che avevo mi funzionava solo in questo modo. Altrimenti se no il discorso dell'impaginazione nel foglio "TipoSfere" è uguale per tutte le tipologie. L'intestazione è sempre uguale. Se noti nel file che ho allegato capita che ci sia solo l'intestazione: questo perchè (con la macro attuale) non salta la tipologia quando effettivamente nn c'è. Non so se è chiaro.
Grazie intanto
Alea
Utente Senior
 
Post: 145
Iscritto il: 24/07/06 14:12

Re: Routine troppo grande

Postdi ricky53 » 21/03/12 01:41

Ciao,
ho fatto delle prova e ... forse funziona ma qualche cosa non mi piace.
Per il momento ho spezzato in due mettendo "SLIM" e "PRO" nella macro "GENERA" e "ECO" nella macro "GENERA_BIS" ecco il listato di GENERA_BIS
Codice: Seleziona tutto
Sub Genera_BIS(sh1, sh6)
' Sfere ECO 180
With sh1
    lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
    lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
        If lRiga2 < 5 Then lRiga2 = 4
           
    'filtro per Sfere ECO 180
            Sheets("Forniture").Select
             ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=E-180" _
        , Operator:=xlAnd
       
             If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
        .Range("A" & lRiga2 + 3).Value = "Codice"
        .Range("B" & lRiga2 + 3).Value = "Nome Progetto"
        .Range("C" & lRiga2 + 3).Value = "Solaio"
        .Range("D" & lRiga2 + 3).Value = "Sistema"
        .Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
        .Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
        .Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
        .Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
        .Range("I" & lRiga2 + 3).Value = "Connettori"
        .Range("J" & lRiga2 + 3).Value = "Impresa"
        .Range("K" & lRiga2 + 3).Value = "Produz."
        .Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
        .Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
        .Range("N" & lRiga2 + 3).Value = "Prefabbric."
            With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
End With

'copio/incollo
    .Range("A4:N100" & lRiga1).Copy _
        Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
    With .Range("F" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0"" sf"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
    With .Range("G" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" g"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
    With .Range("M" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" mq"""
        .Font.Color = -16776961
    End With
End With

With sh6
    Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
    Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With

        End If
End With
 
'tolgo il filtro nel foglio FILE_txt
    With sh1
        .Range("$A$3:$N$3").AutoFilter Field:=5
    End With


' Sfere ECO 225
With sh1
    lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
    lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
        If lRiga2 < 5 Then lRiga2 = 4
           
    'filtro per Sfere ECO 225
            Sheets("Forniture").Select
             ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=E-225" _
        , Operator:=xlAnd
       
             If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
        .Range("A" & lRiga2 + 3).Value = "Codice"
        .Range("B" & lRiga2 + 3).Value = "Nome Progetto"
        .Range("C" & lRiga2 + 3).Value = "Solaio"
        .Range("D" & lRiga2 + 3).Value = "Sistema"
        .Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
        .Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
        .Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
        .Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
        .Range("I" & lRiga2 + 3).Value = "Connettori"
        .Range("J" & lRiga2 + 3).Value = "Impresa"
        .Range("K" & lRiga2 + 3).Value = "Produz."
        .Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
        .Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
        .Range("N" & lRiga2 + 3).Value = "Prefabbric."
            With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
End With

'copio/incollo
    .Range("A4:N100" & lRiga1).Copy _
        Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
    With .Range("F" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0"" sf"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
    With .Range("G" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" g"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
    With .Range("M" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" mq"""
        .Font.Color = -16776961
    End With
End With

With sh6
    Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
    Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With

        End If
End With
 
'tolgo il filtro nel foglio FILE_txt
    With sh1
        .Range("$A$3:$N$3").AutoFilter Field:=5
    End With


' Sfere ECO 270
With sh1
    lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
    lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
        If lRiga2 < 5 Then lRiga2 = 4
           
    'filtro per Sfere ECO 270
            Sheets("Forniture").Select
             ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=E-270" _
        , Operator:=xlAnd
       
             If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
With sh6
        .Range("A" & lRiga2 + 3).Value = "Codice"
        .Range("B" & lRiga2 + 3).Value = "Nome Progetto"
        .Range("C" & lRiga2 + 3).Value = "Solaio"
        .Range("D" & lRiga2 + 3).Value = "Sistema"
        .Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
        .Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
        .Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
        .Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
        .Range("I" & lRiga2 + 3).Value = "Connettori"
        .Range("J" & lRiga2 + 3).Value = "Impresa"
        .Range("K" & lRiga2 + 3).Value = "Produz."
        .Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
        .Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
        .Range("N" & lRiga2 + 3).Value = "Prefabbric."
            With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
End With

'copio/incollo
    .Range("A4:N100" & lRiga1).Copy _
        Destination:=sh6.Range("A" & lRiga2 + 4)
With sh6
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
    With .Range("F" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0"" sf"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
    With .Range("G" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" g"""
        .Font.Color = -16776961
    End With
        lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
    With .Range("M" & lRigafine + 1)
        .Font.Bold = True
        .NumberFormat = "0.00"" mq"""
        .Font.Color = -16776961
    End With
End With

With sh6
    Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
    Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
End With

        End If
End With
 
'tolgo il filtro nel foglio FILE_txt
    With sh1
        .Range("$A$3:$N$3").AutoFilter Field:=5
    End With
' Sfere ECO 360
    With sh1
        lRiga1 = .Range("A" & .Rows.Count).End(xlUp).Row
        lRiga2 = sh6.Range("A" & .Rows.Count).End(xlUp).Row
        If lRiga2 < 5 Then lRiga2 = 4
           
    'filtro per Sfere ECO 360
        Sheets("Forniture").Select
        ActiveSheet.Range("$A$3:$N$100").AutoFilter Field:=5, Criteria1:="=E-360" _
            , Operator:=xlAnd
       
        If .Range("A4" & lRiga1).SpecialCells(xlCellTypeVisible).Count > 1 Then
            With sh6
                .Range("A" & lRiga2 + 3).Value = "Codice"
                .Range("B" & lRiga2 + 3).Value = "Nome Progetto"
                .Range("C" & lRiga2 + 3).Value = "Solaio"
                .Range("D" & lRiga2 + 3).Value = "Sistema"
                .Range("E" & lRiga2 + 3).Value = "Tipologia alleggerimento"
                .Range("F" & lRiga2 + 3).Value = "Nr. Sfere"
                .Range("G" & lRiga2 + 3).Value = "Nr. Gabbie"
                .Range("H" & lRiga2 + 3).Value = "Disegno Modulo"
                .Range("I" & lRiga2 + 3).Value = "Connettori"
                .Range("J" & lRiga2 + 3).Value = "Impresa"
                .Range("K" & lRiga2 + 3).Value = "Produz."
                .Range("L" & lRiga2 + 3).Value = "Relaz. Tecnica"
                .Range("M" & lRiga2 + 3).Value = "Superficie getto [mq]"
                .Range("N" & lRiga2 + 3).Value = "Prefabbric."
                With .Range("A" & lRiga2 + 3 & ":N" & lRiga2 + 3)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlTop
                    .WrapText = True
                End With
            End With
'copio/incollo
            .Range("A4:N100" & lRiga1).Copy _
                Destination:=sh6.Range("A" & lRiga2 + 4)
            With sh6
                lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
                .Range("F" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!F" & lRiga2 + 4 & ":F" & lRigafine & ")"
                With .Range("F" & lRigafine + 1)
                    .Font.Bold = True
                    .NumberFormat = "0"" sf"""
                    .Font.Color = -16776961
                End With
                lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
                .Range("G" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!G" & lRiga2 + 4 & ":G" & lRigafine & ")"
                With .Range("G" & lRigafine + 1)
                    .Font.Bold = True
                    .NumberFormat = "0.00"" g"""
                    .Font.Color = -16776961
                End With
                lRigafine = .Range("A" & .Rows.Count).End(xlUp).Row
                .Range("M" & lRigafine + 1).Value = "=SUM(" & sh6.Name & "!M" & lRiga2 + 4 & ":M" & lRigafine & ")"
                With .Range("M" & lRigafine + 1)
                    .Font.Bold = True
                    .NumberFormat = "0.00"" mq"""
                    .Font.Color = -16776961
                End With
            End With
            With sh6
                Call mBordi1(.Range("A" & lRiga2 + 3 & ":N" & lRigafine))
                Call mBordi2(.Range("A" & lRiga2 + 4 & ":N" & lRigafine))
            End With
        End If
    End With
'tolgo il filtro nel foglio FILE_txt
    With sh1
        .Range("$A$3:$N$3").AutoFilter Field:=5
    End With
End Sub


la chiamata va fatta in questo modo a va inserita prima del codice relativo a "ECO" da 180 a 360 che va tutto cancellato da GENERA
Codice: Seleziona tutto
   Call Genera_BIS(sh1, sh6)
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W10; Office 2003-10-13-16-19
Avatar utente
ricky53
Utente Senior
 
Post: 4565
Iscritto il: 11/04/09 19:29
Località: Italia

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "Routine troppo grande":


Chi c’è in linea

Visitano il forum: Nessuno e 56 ospiti