macro che aggiunge una riga ogni 10 e fa somme

Messaggi
OFFLINE

tbassi

Post: 1

Registrato il: 22/04/2018

Città: MONTECARLO

Età: 68

Utente Junior

2013
00 22/04/2018 09:38
Ho un database in excel i cui dati iniziano alla riga 7 con le intestazioni di colonna e si estendono fino alla colonna J. Il numero di righe è variabile.
Ho necessità di inserire una riga vuota ogni 10 righe e di fare contestualmente la somma delle 10 righe sopra nelle colonne I e J.
Qualcuno può darmi una mano?
Download (36 KB)

GiuseppeMN

Post: 2.842

Registrato il: 03/04/2013

Utente Veteran

Excel 2000 - 2013

00 22/04/2018 12:55

Buona giornata, tbassi;
dai uno sguardo al Codice VBA sotto indicato.
Devo sistemare la somma nelle ultime due Celle in Colonna "I" e "J" ma se il resto della Procedura è corretto posso definire anche questo ultimo dettaglio.

Option Explicit

Sub Aggiungi_e_Somma()
Application.ScreenUpdating = False
Dim NRc As Long, z As Long
Dim x As Integer, RgX As Integer, RgY As Integer
Dim y As Byte

    RgX = 8
    y = 10
        NRc = Range("A" & Rows.Count).End(xlUp).Row / 10
            For z = 1 To NRc
                If Cells(RgX, 1) <> "" And Cells(RgX + y, 1) <> "" Then
                    Cells(RgX + y, 1).EntireRow.Insert
                        Cells(RgX + y, 9).FormulaR1C1 = "=SUM(R" & RgX & "C9:R" & RgX + y - 1 & "C9)"
                        Cells(RgX + y, 10).FormulaR1C1 = "=SUM(R" & RgX & "C10:R" & RgX + y - 1 & "C10)"
                            Range(Cells(RgX + y, 9), Cells(RgX + y, 10)).Font.Color = -16776961
                End If
                    RgX = RgX + y + 1
            Next z
        NRc = Range("A" & Rows.Count).End(xlUp).Row + 1
            Cells(NRc, 9).Select
Application.ScreenUpdating = True
End Sub

A disposizione.

Buon fine settimana.

Giuseppe

Windows XP - Excel 2000
Windows 10 - Excel 2013

OFFLINE

tbassi

Post: 1

Registrato il: 22/04/2018

Città: MONTECARLO

Età: 68

Utente Junior

2013

00 22/04/2018 16:51

Grazie Giuseppe.
Funziona perfettamente e soddisfa la mia esigenza.

OFFLINE

GiuseppeMN

Post: 2.843

Registrato il: 03/04/2013

Utente Veteran

Excel 2000 - 2013

00 22/04/2018 20:28

Buona sera, tbassi;
leggo solo ora.
Grazie del riscontro, non è sempre così scontato.

Sono felice che tu abbia risolto ma ... hai trovato un Giuseppe incontentabile; non potevo esimermi dal cercare di risolvere il "dettaglio", quindi ... :

Option Explicit

Sub Aggiungi_e_Somma()
Application.ScreenUpdating = False
Dim NRc As Long, z As Long
Dim x As Integer, RgX As Integer, RgY As Integer
Dim y As Byte

    RgX = 8
    y = 10
        NRc = Range("A" & Rows.Count).End(xlUp).Row / 10
            For z = 1 To NRc
                If Cells(RgX, 1) <> "" And Cells(RgX + y, 1) <> "" Then
                    Cells(RgX + y, 1).EntireRow.Insert
                        Cells(RgX + y, 9).FormulaR1C1 = "=SUM(R" & RgX & "C9:R" & RgX + y - 1 & "C9)"
                        Cells(RgX + y, 10).FormulaR1C1 = "=SUM(R" & RgX & "C10:R" & RgX + y - 1 & "C10)"
                    Range(Cells(RgX + y, 9), Cells(RgX + y, 10)).Font.Color = -16776961
                End If
                    RgX = RgX + y + 1
            Next z
        NRc = Range("A" & Rows.Count).End(xlUp).Row
            Cells(NRc, 1).Select
                Selection.End(xlUp).Select
        RgY = ActiveCell.Row
            Cells(NRc + 1, 9).FormulaR1C1 = "=SUM(R" & RgY & "C9:R" & NRc & "C9)"
            Cells(NRc + 1, 10).FormulaR1C1 = "=SUM(R" & RgY & "C10:R" & NRc & "C10)"
                Range(Cells(NRc + 1, 9), Cells(NRc + 1, 10)).Font.Color = -16776961
Application.ScreenUpdating = True
    Range(Cells(8, 9), Cells(NRc + 1, 10)).NumberFormat = "#,##0"
End Sub

Magari può essere d'aiuto a qualche altro Utente del Forum.

A disposizione.

Buona serata.

Giuseppe

Windows XP - Excel 2000
Windows 10 - Excel 2013

Excel Forum Per condividere esperienze su Microsoft Excel

macro che aggiunge una riga ogni 10 e fa somme

Anteprima