Cancellare N righe in tabella

[marte1503]

Ciao a tutti,

sto lavorando a una macro per cancellare N righe in tabella, purtroppo con scarsi risultati..

Questa la situazione:

In foglio32 ho creato un pulsante, vorrei che premendolo la macro vada su foglio8, rimuova la protezione, cancelli tutte le righe di Tabella2 (le righe possono essere da 1 a 1000), riapplichi la protezione dell’intero foglio8 e termini in foglio8!B17.

Posso chiedervi un aiuto?

Grazie

[Avatar3]

Con questa macro

Codice: Seleziona tutto

Sub CancTab()

    Sheets("Foglio8").Select
    UR = Range("A" & Rows.Count).End(xlUp).Row
    ActiveSheet.Unprotect
    Rows("1:" & UR).Delete Shift:=xlUp
    Range("B17").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub


Se non vuoi cancellare la prima riga (testata tabella)
cambia questa riga di codice

Codice: Seleziona tutto

Rows("2:" & UR).Delete Shift:=xlUp

(l'1 o 2 o altro numero corrisponde al numero di riga di inizio cancellazione)

[marte1503]

Ciao Avatar3, grazie per il supporto.

Ho provato la macro ma non funziona.

Specifico che Tabella2 in foglio8 ha la riga dei titoli in B19:F19 e ha la riga dei totali, ma non ha un preciso numero di righe (nel senso che le righe vengono aggiunte da una macro che ho creato io, quindi, inizialmente può essere composta di una sola riga di dati, ma il numero può aumentare fino a 1000.)

PS. Nella tua macro ho notato che si fa riferimento a foglio8, ma non c’è tabella2. Per caso tabella2 viene sostituito da UR?

[Anthony47]

Mi inserisco per chiedere, per evitare di complicarci la vita inutilmente: nello stesso foglio8 ci sono altri dati che non vuoi cancellare? Sono nelle stesse colonne B:F? Sopra riga 19?

Ciao

[marte1503]

Ciao Anthony, grazie.

Sì, in foglio 8 sono presenti numerosi dati sopra riga 19 inseriti anche nelle colonne B e F .
Tieni conto che da B1 a G18 il mio foglio contiene dati che non voglio cancellare.

[Anthony47]

Allora, partendo dalla macro di Avatar

Codice: Seleziona tutto

    Sheets("Foglio8").Select
'    UR = Range("A" & Rows.Count).End(xlUp).Row
    ActiveSheet.Unprotect
'    Rows("1:" & UR).Delete Shift:=xlUp
    Range("B19:F" & Rows.count).Clearcontents
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True


Questa ti cancella TUTTO da B19:F19 in giu'; le righe con l' apostrofo diventano inutili.

Ciao.

[Anthony47]

PS: ma la riga dei totali la vuoi invece mantenere? Se SI, e' l' ultima voce che si trova in fondo alla colonna B?

[marte1503]

Ok Anthony, la tua macro va bene.

L'ultima cosa: vorrei che la macro piuttosto che limitarsi a cancellare i dati presenti nella tabella, eliminasse proprio le righe occupate dai dati riportando la tabella all'intervallo di una sola riga.

[marte1503]

...Anthony, non avevo visto il tuo ultimo post.

Sì, la riga del totale la voglio mantenere, (l'unico totale che utilizzo è inserito ai piedi di colonna F), da colonna B a E non viene eseguita nessuna somma nella riga del totale.

[Avatar3]

Ti avevo spiegato che puoi partire da qualsiasi riga di inzio cancellazione
cambiando solo il numero che era nel codice
se vuoi cancellare dalla riga 19 in poi devi sostituire quella riga con questo codice

Codice: Seleziona tutto

Sub CancTab()

    Sheets("Foglio8").Select
    UR = Range("B" & Rows.Count).End(xlUp).Row
IF UR < 19 then UR = 19
    ActiveSheet.Unprotect
    Rows("19:" & UR).Delete Shift:=xlUp
    Range("B17").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub


Anche il codice per il calcolo delle righe (UR)
va modificato se non hai mi dati nella colonna A
quindi, questa volta, ho messo "B"

Ultima cosa siccome UR conta le righe ogni volta che viene avviata la macro non ha importanza se hai una sola riga o 1000 righe la macro le cancellerà tutte dalla riga 19 fino all'ultima riga
se la riga dei totali è l'ultima riga e non la vuoi cancellare
Devi solo modificare il codice sottraendo 1

Codice: Seleziona tutto

    UR = Range("B" & Rows.Count).End(xlUp).Row  - 1

Ricorda che si riferisce alla colonna B (ultima cella piena)

[marte1503]

Grazie Avatar3 ho inserito la macro, è perfetta!

A presto..

[Avatar3]

[marte1503]

Ciao a tutti,
con questa macro creata da Anthony e modificata da Avatar3 riuscivo a cancellare tutte le righe di dati all’interno di una tabella.

Codice: Seleziona tutto

Sub CancTab()

Sheets("Foglio8").Select
UR = Range("B" & Rows.Count).End(xlUp).Row
IF UR < 19 then UR = 19
ActiveSheet.Unprotect
Rows("19:" & UR).Delete Shift:=xlUp
Range("B17").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Ora ho creato un'altra macro che esegue alcuni passaggi che mi servono, tra i quali la funzione che più mi interessa è quella di proteggere Tabella1 (creata in foglio4 con intervallo iniziale A7:D7 per le intestazioni e A9:D9 per la riga del totale. Come l’altra volta alla tabella vengono aggiunte righe tramite attivazione di un’altra macro, quindi non esiste un numero di righe prestabilito).

Questa macro di protezione ha senso se precedentemente viene attivata un’altra macro, che ha il compito di togliere la protezione da Tabella1 per permettermi di eseguire modifiche (che consistono esclusivamente nel cancellare manualmente tramite il tasto CANC i dati presenti in una riga qualsiasi.)
L’altra volta la macro eliminava tutte le righe della tabella non facendo distinzione tra righe vuote o con dati all’interno..

Ora l’obiettivo da raggiungere per il quale vi chiedo un aiuto sarebbe quello di implementare la macro qui sotto, in modo da controllare se in Tabella1 sono presenti righe vuote e eliminarle prima di riattivare la protezione. Ho provato a pasticciare un po’, ma non funziona ancora perfettamente…

(EVIDENZIO LA RIGA AGGIUNTA DA ME)

Codice: Seleziona tutto

Application.ScreenUpdating = False
ActiveSheet.Unprotect
Range("Tabella1[#Headers]").Select
Selection.Copy
Range("Tabella1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A8:D8").Select
Selection.ListObject.ListRows(1).Delete
Range("A5:D5").Select
Selection.Locked = False
Selection.FormulaHidden = False
Range("Tabella1").SpecialCells(xlCellTypeBlanks).EntireRow.Delete  '>>>AGGIUNTA DA ME<<<
Range("Tabella1").Select
Selection.Locked = True
Range("A5").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub

Con la modifica che ho fatto la macro elimina correttamente le righe vuote, ma se non ne trova nemmeno una mi dà un errore..

Mancherebe l'informazione per dire alla macro di uscire dalla sub che nel caso in cui non ci fossero righe vuote e procedere normalmente..

Grazie per l'aiuto
Marte1503

[Flash30005]

Inserisci questo codice prima della riga che dà errore

Codice: Seleziona tutto

On Error resume next

e dopo la riga ripristini il messaggio di errore con

Codice: Seleziona tutto

On Error goto 0

se hai ancora errore in una riga successiva sposti il codice di ripristino dopo la riga di errore
(se dovessi avere ancora errore ripristina l'errore prima dell'End Sub)

Ciao

[marte1503]

Ciao Flash, grazie 1000
con le tue info ho eliminato l'errore

L'ultima cosa
mi sono accorto ora che l'eliminazione avviene solo se la righa dalla quale ho eliminato i dati è soltanto 1, se sono 2 o più, la macro non le elimina.
Che informazione manca?
Grazie

[Flash30005]

Non capisco se non funziona più regolarmente dopo quest'ultima modifica oppure
questo bug lo avevi anche prima

[marte1503]

Hai ragione non ho specificato
L'avevo già da prima della tua modifica

[Flash30005]

Ho fatto un test con questo codice e funziona benissimo (non avendo il range Tabella ho inserito le coordinate)

Codice: Seleziona tutto

Range("A9:B30").SpecialCells(xlCellTypeBlanks).EntireRow.Delete  '>>>AGGIUNTA DA ME<<<

Se non risolvi invia il file


ciao

[marte1503]

Ciao Flash, ciao a tutti.

Come dicevo all’inizio nel mio post del 24/07/11 09:10 le coordinate della tabella sono variabili, solo la riga delle intestazioni non viene mai spostata , è in A7:D7.

Il problema è che allo stato attuale la macro elimina le righe dalle quali ho cancellato i dati solo se si trovano vicine, se tra una riga e l’altra si trovano righe con valori all’interno la macro esce dalla sub, e riattiva la protezione senza aver effettuato la rimozione.

Per ovviare al problema ho fatto un esperimento, ho provato ad applicare (in qualche modo….) la soluzione suggerita da Avatar3 aggiungendo un controllo UR
La macro ora è così, ma non elimina più le righe, nemmeno se è soltanto una…

Codice: Seleziona tutto

Application.ScreenUpdating = False
    ActiveSheet.Unprotect
    Range("Tabella1[#Headers]").Select
    Selection.Copy
    Range("Tabella1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A8:D8").Select
    Selection.ListObject.ListRows(1).Delete
    Range("A5:D5").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    On Error Resume Next
    Sheets("Foglio4").Select
    UR = Range("D" & Rows.Count).End(xlUp).Row - 1
If UR < 7 Then UR = 7
     Rows("7:" & UR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("A5").Select
    On Error GoTo 0
    Range("Tabella1").Select
    Selection.Locked = True
    Range("A5").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub

Aspetto un suggerimento..
Grazie a tutti.

[Avatar3]

Quando fai dei test e provi i codici commenta la visualizzazione errori

Codice: Seleziona tutto

 
'On Error Resume Next   '<<<<<<<<< commentare
    Sheets("Foglio4").Select
    UR = Range("D" & Rows.Count).End(xlUp).Row - 1
If UR < 7 Then UR = 7
     Rows("7:" & UR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("A5").Select
   ' On Error GoTo 0  '<<<<<< commentare


Altrimenti in caso di errore non sai dove intervenire e non hai alcun effetto, in questo caso, di cancellazione righe
xlcellblanks credo lavori su un range e non sulle righe perché se così fosse sarebbe stata cancellata l'intera tabella
quindi usa

Codice: Seleziona tutto

 Range("A7:B" & UR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

oppure Range("A7:E" & UR), insomma le colonne che ti occorrono (le righe sono determinate da UR