Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Somma automatica a fine pagina e riporto a pagina successiva.

434 views
Skip to first unread message

Giacomo

unread,
Mar 23, 2005, 12:51:03 AM3/23/05
to
Premetto che non sono esperto di macro. Ho questo problema. In un foglio di
lavoro ci sono delle lunghissime colonne di dati che che si estendono per
centinaia di pagine. Vorrei creare una macro che mi possa fare queste
operazioni:
1) sull'ultima riga della prima pagina deve fare le somme sotto ogni colonna;
2) deve riportare tali somme nella prima riga della seconda pagina
all'inizio delle rispettive colonne;
3) deve continuare tali operazioni fino al termine del foglio di lavaro.
Ringrazio anticipatamente chi vorrà fornirmi un aiuto.

Maurizio

unread,
Mar 23, 2005, 5:23:13 AM3/23/05
to
Se invii la tua mail ti spedisco un mio lavoro simile.

--
Maurizio
"Giacomo" <Gia...@discussions.microsoft.com> ha scritto nel messaggio
news:1A6E9D34-C365-4ECA...@microsoft.com...

> Ringrazio anticipatamente chi vorrą fornirmi un aiuto.


Giacomo

unread,
Mar 23, 2005, 6:03:04 AM3/23/05
to
Ti invio il mio indirizzo e-mail: delgi...@libero.it
Ti ringrazio per l'interessamento.

"Maurizio" ha scritto:

> > Ringrazio anticipatamente chi vorrà fornirmi un aiuto.
>
>
>

eliano

unread,
Mar 23, 2005, 6:51:02 AM3/23/05
to

"Maurizio" ha scritto:

> Se invii la tua mail ti spedisco un mio lavoro simile.
>

E noi? dobbiamo cominciare a preoccuparci per le nostre madri??
Eliano

Maurizio

unread,
Mar 23, 2005, 9:20:18 AM3/23/05
to
>> Se invii la tua mail ti spedisco un mio lavoro simile.
>>
>> --
>> Maurizio
>> "Giacomo" <Gia...@discussions.microsoft.com> ha scritto nel messaggio
>> news:1A6E9D34-C365-4ECA...@microsoft.com...
>> > Premetto che non sono esperto di macro. Ho questo problema. In un
>> > foglio
>> > di
>> > lavoro ci sono delle lunghissime colonne di dati che che si estendono
>> > per
>> > centinaia di pagine. Vorrei creare una macro che mi possa fare queste
>> > operazioni:
>> > 1) sull'ultima riga della prima pagina deve fare le somme sotto ogni
>> > colonna;
>> > 2) deve riportare tali somme nella prima riga della seconda pagina
>> > all'inizio delle rispettive colonne;
>> > 3) deve continuare tali operazioni fino al termine del foglio di
>> > lavaro.
>> > Ringrazio anticipatamente chi vorrą fornirmi un aiuto.
>>
>>

Intanto ti invio il codice gią precedentemente inviato:

http://groups.google.com/groups?hl=it&lr=&threadm=eE9%24sXILEHA.1612%40TK2MSFTNGP12.phx.gbl&rnum=1&prev=/groups%3Fq%3DHPageBreaks%26hl%3Dit%26lr%3D%26group%3Dmicrosoft.public.it.office.excel%26selm%3DeE9%2524sXILEHA.1612%2540TK2MSFTNGP12.phx.gbl%26rnum%3D1

cmq, premesso un foglio con 4 colonne e sulla quarta colonna necessito della
somma-riporto:
prova-adatta questa routine:

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

Ciao.


laurade...@gmail.com

unread,
Oct 15, 2012, 5:18:18 AM10/15/12
to
Ciao, puoi spiegarmi come utilizzare questa macro per visualizzare in stampa all'ultima riga la voce "Da riportare" con la somma degli importi della pagina corrente, e la voce "Riporto" alla prima riga con la somma degli importi della pagina precedente?
0 new messages