Si tratta di ripetere tutto quel ciclo per ogni riga
quindi calcolare le righe con una variabile (Es. UR)
e con un ciclo For...next scansionare tutte le righe
chiaramente la riga di riferimento non sarà più fissa come nel caso precedente
- Codice: Seleziona tutto
Cells(1, CC)
ma sarà
- Codice: Seleziona tutto
Cells(RR, CC)
detto questo
ti invio la macro che conterà tutte le righe del foglio e compilerà la tabella da W a ...
- Codice: Seleziona tutto
Sub ContaVal()
Application.Calculation = xlManual
UR = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row
For RR = 1 To UR
ContaN = 0
UC = Worksheets("Foglio1").Cells(RR, 1).End(xlToRight).Column
For CC = 1 To UC
If Cells(RR, CC) <> 0 Then
ContaN = ContaN + 1
Else
UN = Worksheets("Foglio1").Cells(RR, 255).End(xlToLeft).Column + 1
If UN - UC < 3 Then UN = UC + 3
Cells(RR, UN).Value = ContaN
ContaN = 0
End If
Next CC
If ContaN <> 0 Then
UN = Worksheets("Foglio1").Cells(RR, 255).End(xlToLeft).Column + 1
Cells(RR, UN).Value = ContaN
End If
Next RR
Application.Calculation = xlCalculationAutomatic
End Sub
Se i dati origine cambiano sul foglio dovrai per forza pulire la tabella valori aggiunta
e rilanciare la macro
per pulire la tabella valori aggiunta
devi calcolare sia le righe che le colonne
e cancellare quell'area con una macro tipo questa
- Codice: Seleziona tutto
Private Sub CalcolaAreaECanc()
righe = Range("W1").CurrentRegion.Rows.Count
col = Range("W1").CurrentRegion.Columns.Count
Range(Cells(1, 23), Cells(righe, 23 + col)).ClearContents
End Sub
se vuoi fare tutto in automatico cioè cancellare l'area puoi richiamare questa macro all'inizio della precedente
(ti riporto un esempio)
- Codice: Seleziona tutto
Sub ContaVal()
Application.Calculation = xlManual '<<<< riga esistente
Call CalcolaAreaECanc '<<<<<<<<< riga aggiunta che richiama la macro di cancellazione area
UR = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row '<<<< riga esistente
Fai sapere se tutto ok
ciao