RIPORTI E TOTALI FINE PAGINA EXCEL

Hai un problema con Excel?

Nuova discussione

RIPORTI E TOTALI FINE PAGINA EXCEL
di ANGELINO (utente non iscritto) data: 08/12/2015 17:23:39
Buongiorno a tutti, grazie per l'aiuto che mi saprete dare.
sono alle prese con un foglio excel con un migliaio di righe e una ventina di colonne.
ho necessita di stampare questo foglio con i totali di colonna ogni fine pagina e riportarli come prima riga dopo l'intestazione di colonna nella pagina successiva fino alla fine.
mi potreste aiutare con la vostra esperienza?
Grazie
Sostituire dei valori preimpostati
di DPG70 (utente non iscritto) data: 08/12/2015 17:42:49
Precedo con un grosso saluto a tutti, intervengo per chiedere se esiste una soluzione alla mia macro per velocizzare il suo procedimento.
Ovvero, con un file composto da migliaia di righe di inserimento, la mia macro che sostituisce per ogni riga il valore unitario preimpostato di una sigola risorsa specifica,
impiega molto tempo per completarsi.
Cercavo una soluzione in vba che mi porti al risultato chiesto, in modo più rapido.
Grazie, Dario.
Sub Prezziorari() Dim i As Integer For i = 10 To 5000 If Cells(i, 55) = "Tizio operaio" Then Cells(i, 60) = "8,00" i = i + 1 End If Next End Sub

di Mister_x (utente non iscritto) data: 08/12/2015 20:31:19
ciao Angelino

la cosa e' un pochino complessa da risolvere , in quanto non conoscendo la struttura del tuo file e su che formato stampi , se A4 sicuramente orizzontale perché 20 colonne in verticale a mio parere nom ci stanno, comunque se questo e' un file di primanota la cosa va risolta con un foglio di appoggio impostato per stampa o con una sub() un pochino complessa, a mio parere e migliore un foglio di appoggio per stampe impostato una sola volta per sempre

Per DPG70 hai postato in un'altra discussione , dovevi farne una tua comunque comunque la sub() da come penso
tu abbia moltissime formule in quel foglio, rallentamento di operazioni va impostata in questo modo
altra cosa le ore se devono essere veramente ore vanno impostate in questo modo come valcolo
Cells(i, 60) = 1/24*8 queste sono 8 ore altrimenti se vuoi un valore
Cells(i, 60) = 8 valore 8 formato cella con 2 decimali =8,00
Cells(i, 60) = "8,00" tu hai una stringa senza nessun valore

ciao a tutti e due

Option Explicit
Sub Prezziorari()
Dim i As Long  '' a 32 bit
Application.EnableEvents = False
Application.Calculation = xlManual  ''calcolo funzioni disabilitato
 For i = 10 To 5000
    If Cells(i, 55) = "Tizio operaio" Then
        Cells(i, 60) = "8,00"
    End If
 Next
Application.Calculation = xlAutomatic  '' abilita
Application.EnableEvents = True
Calculate  ''Calcola una sola volta
End Sub

di ANGELINO (utente non iscritto) data: 09/12/2015 18:50:10
Grazie Mister_x ,
la stampa è in A3 orizzontale, convengo con l'indicazione di utilizzare per la stampa un foglio separato.
Ho trovato un pezzo di codice che allego, purtroppo non funziona correttamente, ho dimensionato le righe per pagina e non mi ha dato errore ma dopo aver effettuato il primo calcolo di totali se lancio la sub di rimozione non funziona. Inoltre mi servirebbero i totali su tutte le colonne escluse le prime due.

Grazie

A    B            C                        D
PR-DATA-DESCRIZIONE-IMPORTO

è necessario verificare ed eventualmente eliminare riporti parziali già
creati:

Sub Riporti()

    Dim Riga(1000) As Integer
    Dim i As Integer
    Dim k As Integer
    Dim TotRip As String
    Dim tb As Worksheet

    Application.ScreenUpdating = False

    'elimina vecchi riporti e/o righe di calcolo
        Set tb = Worksheets(1)
        TotRighe =
Application.WorksheetFunction.CountA(Worksheets(1).Range("D:D"))

        For k = 2 To TotRighe
            If IsEmpty(tb.Cells(k, 1)) Then tb.Rows(k).EntireRow.Delete
        Next k

    Rows(2).Insert
    Rows(2).Select
    Selection.Font.Bold = False

    Cells(2, 3) = "Riporto Iniziale"
    Cells(2, 3).Font.Bold = True
    Cells(2, 4) = 0
    Cells(2, 4).NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
    Cells(2, 4).Font.Bold = True

    Application.Goto Reference:=Worksheets(1).Cells(65536, 1).End(xlUp),
Scroll:=True
'    necessario x calcolare N. pagine
    NPag = Worksheets(1).HPageBreaks.Count 'conta esistenza N. pagine -1
'    MsgBox "Numero di pagine: " & NPag + 1

    If NPag = 0 Then GoTo Fine

    For i = 1 To CInt(NPag)
        Riga(i) = Worksheets(1).HPageBreaks(i).Location.Row
    Next i

    Riga(0) = 0
    For i = 1 To NPag
        Cells(Riga(i), 4).Select
        Selection.EntireRow.Insert
            TotRip = "=ROUND(sum(D" & CStr(Riga(i - 1)) & ":D" &
CStr(Riga(i) - 1) & "),2)"
        Cells(Riga(i), 4) = TotRip
        Cells(Riga(i), 4).Font.Bold = True
        Cells(Riga(i), 3) = "Riporto"
        Cells(Riga(i), 3).Font.Bold = True
    Next i

    'ricorregge prima formula
    PrimaForm = Worksheets(1).HPageBreaks(1).Location.Row
    Cells(PrimaForm, 4) = "=ROUND(sum(D1:D" & CStr(PrimaForm - 1) & "),2)"

    'ultima formula
    Riga_z = Cells(65536, 4).End(xlUp).Row
    Riga_a = Cells(Riga_z, 2).End(xlUp).Row
    Cells(65536, 4).End(xlUp).Offset(1, 0) = "=ROUND(sum(D" & CStr(Riga_a -
1) & ":D" & CStr(Riga_z) & "),2)"
    Cells(65536, 4).End(xlUp).Offset(1, 0).Font.Bold = True
    Cells(65536, 3).End(xlUp).Offset(1, 0) = "Totale"
    Cells(65536, 3).End(xlUp).Offset(1, 0).Font.Bold = True

    Application.Goto Reference:=Worksheets(1).Cells(2, 1), Scroll:=True

Exit Sub

Fine:
    Riga_z = Cells(65536, 4).End(xlUp).Row
    Cells(65536, 4).End(xlUp).Offset(1, 0) = "=ROUND(sum(D2:D" &
CStr(Riga_z) & "),2)"
    Cells(65536, 4).End(xlUp).Offset(1, 0).Font.Bold = True
    Cells(65536, 3).End(xlUp).Offset(1, 0) = "Totale"
    Cells(65536, 3).End(xlUp).Offset(1, 0).Font.Bold = True

    Application.Goto Reference:=Worksheets(1).Cells(2, 1), Scroll:=True

End Sub
Sub EliminaRiporti()

    Dim k As Integer
    Dim TotRighe
    Dim tb As Worksheet

    Application.ScreenUpdating = False

    Set tb = Worksheets(1)
    TotRighe =
Application.WorksheetFunction.CountA(Worksheets(1).Range("D:D"))

    For k = 2 To TotRighe
        If IsEmpty(tb.Cells(k, 1)) Then tb.Rows(k).EntireRow.Delete
    Next k
    Application.Goto Reference:=Worksheets(1).Cells(2, 1), Scroll:=True

End Sub

Vuoi Approfondire?