| | Post: 1 | Registrato il: 22/04/2018
| Città: MONTECARLO | Età: 68 | Utente Junior | 2013 | | OFFLINE | |
|
  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? |
|
| | Post: 2.842 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 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 |
| | Post: 1 | Registrato il: 22/04/2018
| Città: MONTECARLO | Età: 68 | Utente Junior | 2013 | | OFFLINE | |
|
| 22/04/2018 16:51 | |
Grazie Giuseppe.
Funziona perfettamente e soddisfa la mia esigenza.
![[SM=x423047]](http://www.erismag.it/Servizio/ForumExcel/Smiles/Faccina_0027.gif)
|
| | Post: 2.843 | Registrato il: 03/04/2013
| Utente Veteran | Excel 2000 - 2013 | | OFFLINE | |
|
| 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 |
|
|
|
|