-
Articoli
-
Ciao,
nel workbook allegato nel foglio1 ci sono 2 pulsanti gialli collegati alle 2 macro nel modulo1/2seleziono una riga > clicco "elimina 1 riga selezionata" questa viene cancellata e poi aggiunta
una riga vuota alla fine.
Le righe restano fino a 77Se resta solo 1 riga da eliminare, la 5, la macro non aggiunge una nuova riga ma ne toglie 1
La colpa è qui:
If n > 5 Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Insert '<<< elimina dalla riga 3
Non posso modificare perchè la riga 4 deve restare nera.Option Explicit Sub EliminaRiga_1() Dim n As Long Dim X As Long Dim avviso As String Dim LastRow As Long avviso = MsgBox("Sign. < " & Environ("UserName") & " >" & Chr(13) & " " & Chr(13) & _ "Vuoi eliminare riga < " & ActiveCell.Row & " > selezionata?", vbOKCancel + vbInformation, "ELIMINA RIGA!") If avviso = vbCancel Then Exit Sub n = ActiveCell.Row If n < 4 Then avviso = MsgBox("Sign. < " & Environ("UserName") & " >" & Chr(13) & " " & Chr(13) & _ "le prime 4 righe non si possono eliminare!", vbOKOnly + vbCritical, "ELIMINA RIGA!") Exit Sub Else ActiveSheet.Unprotect "123456" Application.EnableEvents = False Rows(n).EntireRow.Delete 'elimina solo una riga 'Range("A" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Insert If n > 5 Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Insert '<<< elimina dalla riga 3 ActiveSheet.Protect "123456" Application.EnableEvents = True 'Cells(ActiveCell.Row, 1).Select 'End If End If Cells(ActiveCell.Row, 1).Select 'Range("A" & Cells.Rows.Count).End(xlUp).Select '[A3].Select End SubSe n e' minore di 4 allora avvisa ed esci.
Altrimenti, elimina una riga.
Se poi n e' maggiore di 5 allora inserisci una nuova riga.
Quindi se n e' uguale a 5 non inserisce la riga (ne cancella una perche' siamo nel ramo Else dell'If precedente che testava n minore di 4).
Io porrei la condizione che se n e' maggiore o uguale a 5 allora inserisci la riga.
Ne consegue che l'If ... Then e' inutile e puoi lasciare l'istruzione di inserimento riga senza bisogno di alcun test.
Ho provato, ma non funziona
If n > 5 Or n = 5 Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Insert '<<< elimina dalla riga 3
Se ho capito bene cosa vuoi fare, e cioe' eliminare le righe dalla 5 in poi una alla volta ma far rimanere sempre il numero delle righe uguale, secondo me ci sono due errori:
Il primo If n < 4 Then dovrebbe essere If n < 5 Then, altrimenti ti fa cancellare anche la riga 4
Il secondo If n > 4 Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Insert dovrebbe essere If n > 5 Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Insert
in quanto quando elimini l'ultima riga, la 5, sei posizionato appunto sulla riga 5 e se gli dici di inserire la riga solo se n > 5 non lo fara' mai.
Cambiato, ma se seleziono la riga 5 non si aggiunge una riga.
Sub EliminaRiga_1() Dim n As Long Dim X As Long Dim avviso As String Dim LastRow As Long avviso = MsgBox("Sign. < " & Environ("UserName") & " >" & Chr(13) & " " & Chr(13) & _ "Vuoi eliminare riga < " & ActiveCell.Row & " > selezionata?", vbOKCancel + vbInformation, "ELIMINA RIGA!") If avviso = vbCancel Then Exit Sub n = ActiveCell.Row If n < 5 Then avviso = MsgBox("Sign. < " & Environ("UserName") & " >" & Chr(13) & " " & Chr(13) & _ "le prime 4 righe non si possono eliminare!", vbOKOnly + vbCritical, "ELIMINA RIGA!") Exit Sub Else ActiveSheet.Unprotect "123456" Application.EnableEvents = False Rows(n).EntireRow.Delete 'elimina solo una riga 'Range("A" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Insert If n > 5 Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Insert '<<< elimina dalla riga 3 ActiveSheet.Protect "123456" Application.EnableEvents = True 'Cells(ActiveCell.Row, 1).Select 'End If End If Cells(ActiveCell.Row, 1).Select 'Range("A" & Cells.Rows.Count).End(xlUp).Select '[A3].Select End Subciao
non ho letto tutta la macro
ma se vuoi che parta dalla 5 mio avviso
If n > 5 Then R
diventa
If n >= 5 Then R
anche se mi sembra ripetitivo
se <5 fai questo altrimenti fai altro
If n<5 Then
x
Else
Y
Anche questo non va
If n >= 5 Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Insert
Anche così non va
ActiveSheet.Unprotect "123456" Application.EnableEvents = False Rows(n).EntireRow.Delete 'elimina solo una riga 'Range("A" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Insert If n > 5 Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Insert Else If n = 5 Then Rows(n).EntireRow.ClearContents 'elimina solo una riga End If End If ActiveSheet.Protect "123456" Application.EnableEvents = TrueVedi così per quanto riguarda Elimina Riga_1
Per l'altra macro fai uguale
`Sub EliminaRiga_1() Dim n As Long Dim X As Long Dim avviso As String Dim LastRow As Long Dim Rg As Variant avviso = MsgBox("Sign. < " & Environ("UserName") & " >" & Chr(13) & " " & Chr(13) & _ "Vuoi eliminare riga < " & ActiveCell.Row & " > selezionata?", vbOKCancel + vbInformation, "ELIMINA RIGA!") If avviso = vbCancel Then Exit Sub n = ActiveCell.Row If n < 4 Then avviso = MsgBox("Sign. < " & Environ("UserName") & " >" & Chr(13) & " " & Chr(13) & _ "le prime 4 righe non si possono eliminare!", vbOKOnly + vbCritical, "ELIMINA RIGA!") Exit Sub Else ActiveSheet.Unprotect "123456" Application.EnableEvents = False Rows(n).EntireRow.Delete 'elimina solo una riga If n > 5 Then Rg = 1 Else Rg = 5 Range("A" & Rows.Count).End(xlUp).Offset(Rg, 0).EntireRow.Insert '<<< elimina dalla riga 3 ActiveSheet.Protect "123456" Application.EnableEvents = True End If Cells(ActiveCell.Row, 1).Select End Sub`Oscar, non va.
Se seleziono la riga 5 non crea una nuova riga in più resta vuota
Oscar, non va.
Se seleziono la riga 5 non crea una nuova riga in più resta vuota
Si ho capito che eliminando una riga , ne aggiunge una vuota o no
seleziono una riga > clicco "elimina 1 riga selezionata" questa viene cancellata e poi aggiunta una riga vuota alla fine.
Le righe restano fino a 77Tu hai scritto così
Si in effetti ha ragione
Oscar, la tua modifica funziona.
Probablimente ho sbagliato qualcosa.
Vedi adesso
Allego il tuo File vedi anche elimina righe
Mi sembra che non va bene elimina righe se selezioni alla fine non le aggiunge
`Option Explicit Sub EliminaRiga_1() Dim n As Long Dim X As Long Dim avviso As String Dim LastRow As Long Dim Rg As Variant avviso = MsgBox("Sign. < " & Environ("UserName") & " >" & Chr(13) & " " & Chr(13) & _ "Vuoi eliminare riga < " & ActiveCell.Row & " > selezionata?", vbOKCancel + vbInformation, "ELIMINA RIGA!") If avviso = vbCancel Then Exit Sub n = ActiveCell.Row If n < 4 Then avviso = MsgBox("Sign. < " & Environ("UserName") & " >" & Chr(13) & " " & Chr(13) & _ "le prime 4 righe non si possono eliminare!", vbOKOnly + vbCritical, "ELIMINA RIGA!") Exit Sub Else ActiveSheet.Unprotect "123456" Application.EnableEvents = False Rows(n).EntireRow.Delete 'elimina solo una riga If n = 5 Then n = 5 Else n = n Range("A" & Rows.Count).End(xlUp).Offset(n, 0).EntireRow.Insert '<<< elimina dalla riga 3 ActiveSheet.Protect "123456" Application.EnableEvents = True End If Cells(ActiveCell.Row, 1).Select End Sub`Grazie oscar
funziona sia "1 riga selezionata" che "righe selezionate"
Anche se selezioni alla fine
If n = 5 Then n = 5 Else n = n
If n = 5 Then n = 5 Else n = n
Quindi era sufficente così
Range("A" & Rows.Count).End(xlUp).Offset(n, 0).EntireRow.Insert '<<< elimina dalla riga 3
Oppure
If n <5 Then n = 5 Else n = n
Adesso che ci penso hai ragione
Forse tecnicamente andrebbe meglio così:
Option Explicit Sub EliminaRiga_1() Dim n As Long If ActiveCell.Row < 5 Then MsgBox "Sign. < " & Environ("UserName") & " >" & Chr(13) & " " & Chr(13) & _ "le prime 4 righe non si possono eliminare!", vbCritical, "ELIMINA RIGA!" Exit Sub End If If MsgBox("Sign. < " & Environ("UserName") & " >" & Chr(13) & " " & Chr(13) & _ "Vuoi eliminare riga < " & ActiveCell.Row & " > selezionata?", vbOKCancel + vbInformation, "ELIMINA RIGA!") = vbCancel Then Exit Sub ActiveSheet.Unprotect "123456" Application.EnableEvents = False Rows(ActiveCell.Row).EntireRow.Delete 'elimina solo una riga n = Range("A" & Rows.Count).End(xlUp).Row + 1 If n < 5 Then n = 5 Rows(n).EntireRow.Insert Rows(n).Interior.ColorIndex = xlNone ActiveSheet.Protect "123456" Application.EnableEvents = True Cells(n, 1).Select End SubUnica accortezza...nel rigo 4 (quello con il fondo nero per intenderci), bisogna sistemare il Font e renderlo uguale a quello delle righe sottostanti e togliere anche il Grassetto. Questo perché quando si cancellerà il quinto rigo, il nuovo inserimento erediterebbe lo stesso formato del quarto rigo: fondo nero, font e grassetto.
If n < 5 Then n = 5
Giusto
Ma poi mi domando a che cosa servono utilizzare 2 macro per eliminare righe? Quella che elimina più righe contemporaneamente può benissimo eliminare anche una sola! Ad esempio, questo codice rivisitato, copre entrambe le situzioni:
Option Explicit Sub EliminaRiga_1() Dim n As Long Dim Ros As Long Dim s As String Dim r As Variant If ActiveCell.Row < 5 Then MsgBox "Sign. < " & Environ("UserName") & " >" & Chr(13) & " " & Chr(13) & _ "le prime 4 righe non si possono eliminare!", vbCritical, "ELIMINA RIGA!" Exit Sub End If For Each r In Selection.Rows s = s & "-" & r.Row Ros = Ros + 1 Next r If MsgBox("Sign. < " & Environ("UserName") & " >" & Chr(13) & " " & Chr(13) & _ "Vuoi eliminare la/le riga/ghe " & vbCrLf & " < " & _ Mid(s, 2) & " > " & vbCrLf & "selezionata/te?", vbOKCancel + vbInformation, "ELIMINA RIGHE!") = vbCancel Then Exit Sub ActiveSheet.Unprotect "123456" Application.EnableEvents = False Selection.EntireRow.Delete n = Range("A" & Rows.Count).End(xlUp).Row + 1 If n < 5 Then n = 5 Rows(n).Resize(Ros).EntireRow.Insert Rows(n).Resize(Ros).Interior.ColorIndex = xlNone ActiveSheet.Protect "123456" Application.EnableEvents = True Cells(n, 1).Select End SubVale sempre il discorso fatto nel mio ultimo post inerente al rigo n° 4 (aggiungo anche che bisogna tutti i bordi a quel rigo)
Ciao alexps81 la tua ultima macro post#47481 non funziona tanto esatto.
Se resta solo 1 riga da elinare oppure seleziono tutte le righe poi queste vengono ricopiate dalla riga 5 in poi
Ciao @frank_ciccio
ho provato e funziona tutto perfettamente. Hai apportato le modifiche al rigo n° 4 come ho indicato alla fine dei post #47479 e #47481?
Unica accortezza...nel rigo 4 (quello con il fondo nero per intenderci), bisogna sistemare il Font e renderlo uguale a quello delle righe sottostanti e togliere anche il Grassetto. Questo perché quando si cancellerà il quinto rigo, il nuovo inserimento erediterebbe lo stesso formato del quarto rigo: fondo nero, font e grassetto.
Vale sempre il discorso fatto nel mio ultimo post inerente al rigo n° 4 (aggiungo anche che bisogna tutti i bordi a quel rigo)
al rigo 4, nel range("A4:K4") devi togliere il grassetto, applicare font e fontsize uguale com'è per il resto della tabella. Inoltre metti i bordi sottili a tutte le celle sempre a quel range.
Ciao alexps81 la tua ultima macro post#47481 non funziona tanto esatto.
Se resta solo 1 riga da elinare oppure seleziono tutte le righe poi queste vengono ricopiate dalla riga 5 in poi
M'ha non conosco la struttura completa del tuo File e non so cosa hai dalla riga 77 in poi , comunque eliminare righe , per poi aggiungerne delle vuote sotto (non è mai stato un buon metodo) se non hai niente e le aggiungi solo per la griglia , ti basta ripristinare la griglia e ti togli subito il mal di pancia
Ti allego anche il File se vuoi provarlo
Grazie oscar la tua macro funziona
Login
Registrati
Stai vedendo 25 articoli - dal 1 a 25 (di 25 totali)
Stai vedendo 25 articoli - dal 1 a 25 (di 25 totali)