Risultati da 1 a 6 di 6

Discussione: Eliminare righe complete su più fogli di lavoro con 1 condizione



  1. #1
    L'avatar di G.Bove
    Clicca e Apri
    Data Registrazione
    Oct 2015
    Località
    Milano
    Età
    51
    Messaggi
    870
    Versione Office
    2010
    Likes ricevuti
    24
    Likes dati
    186

    Eliminare righe complete su più fogli di lavoro con 1 condizione

    Ciao a tutti,
    a margine del thread Copiare con condizione , Giuseppe (ggratis) che ringrazio, ha postato una soluzione per adattare all'evoluzione del file, il tasto Elimina presente nel form del foglio di lavoro Anagrafica.

    Citazione Originariamente Scritto da ggratis Visualizza Messaggio
    una possibile procedura per aggiornare il tasto elimina...

    ci sono delle incongruenze nei dati archiviati, per cui l'effetto in alcuni punti non è quello sperato ...ma con opportuni aggiustamenti anche sui dati archiviati dovrebbe funzionare...
    cancella tutti i nomi ripetuti...

    saluti
    gg

    Codice: 
    
    
    Private Sub Label38_Click()
    
    
    Dim wks As Worksheet, wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
    Dim wks4 As Worksheet, wks5 As Worksheet, wks6 As Worksheet, wks7 As Worksheet
    Dim uRiga As Long, uRiga1 As Long, uRiga2 As Long, uRiga3 As Long, uRiga4 As Long, uRiga5 As Long, uRiga6 As Long
    Dim nominativo As String
    Dim Cella As Range
    
    
    Set wks = Sheets("Anagrafica")
    Set wks1 = Sheets("0_Nuovo assunto")
    Set wks2 = Sheets("3_SqEmergenza")
    Set wks3 = Sheets("1_Formazione Sicurezza")
    Set wks4 = Sheets("2_Aggiornamenti")
    Set wks5 = Sheets("4_Addestramento Specifico")
    Set wks6 = Sheets("1_Formaz Somm")
    Set wks7 = Sheets("Anagrafica (2)")
    
    
    
    
    Dim Silinecek_Satir, i As Long
    Dim cevap As String
    
    
    If TextBox1 = "" Or TextBox2 = "" Then
    Call MsgBox("Selezionare il contatto da eliminare", vbInformation, "Avviso")
    Exit Sub
    End If
        If ListBox1.ListIndex >= 0 Then
            cevap = MsgBox("Il contatto verrà cancellato." _
            & vbCrLf & "Vuoi procedere?", vbYesNo, "Avviso")
            If cevap = vbYes Then
                
                nominativo = TextBox1 & " " & TextBox2
                '---------------------elimino nominativo del foglio "anagrafica"
                 With wks
                uRiga = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("C3:C" & uRiga)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                
               Call Aggiorna
               
                '---------------------elimino nominativo del foglio "0_Nuovo assunto"
                With wks1
                uRiga1 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A7:A" & uRiga1)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "3_SqEmergenza"
                With wks2
                uRiga2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A5:A" & uRiga2)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "1_Formazione Sicurezza"
                With wks3
                uRiga3 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A7:A" & uRiga3)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "2_Aggiornamenti"
                With wks4
                uRiga4 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A5:A" & uRiga4)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "4_Addestramento Specifico"
                With wks5
                uRiga5 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A7:A" & uRiga5)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "1_Formaz Somm"
                With wks6
                uRiga6 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A7:A" & uRiga6)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "Anagrafica (2)"
                With wks7
                uRiga7 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("C4:C" & uRiga7)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
            End If
        End If
     End Sub
    Come dovrebbe lavorare: La selezione del nominativo "dice" alla macro cosa cercare nell'intero file per poi cancellare l'intera riga corrispondente.

    In realtà, dopo vari tests,il limite di questa macro sembra essere che in realtà, come scritto dallo stesso Giuseppe nei commenti alla macro, non elimina la riga completa ma soltanto il contenuto delle varie celle lasciando un fastidioso #RIF!.

    E' sistemabile?
    https://www.dropbox.com/s/jc6rwa5fmt...rove.xlsm?dl=0

    Grazie in anticipo.
    Gene

  2. #2
    L'avatar di ggratis
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Lecce - Pisa
    Età
    45
    Messaggi
    737
    Versione Office
    Excel 2010
    Likes ricevuti
    257
    Likes dati
    215

    Re: Eliminare righe complete su più fogli di lavoro con 1 condizione

    Citazione Originariamente Scritto da G.Bove Visualizza Messaggio
    In realtà, dopo vari tests,il limite di questa macro sembra essere che in realtà, come scritto dallo stesso Giuseppe nei commenti alla macro, non elimina la riga completa ma soltanto il contenuto delle varie celle lasciando un fastidioso #RIF!.
    Gene
    Piccola precisazione,
    è un problema del codice ma anche del database ed eventualmente di ordine di eliminazione delle righe.
    nel foglio "0_Nuovo assunto" per esempio alcune celle della colonna A sono scritte in questo modo:
    =SE(Anagrafica!C3<>"";Anagrafica!C3;"")
    altre invece evidentemente probabilmente scritte tramite codice riportano la stringa del nome
    chiaramente se in anagrafica io cancello la riga C3 (del nominativo interessato) prima di eliminare la riga in "0_nuovo assunto", viene perso il riferimento e quindi quando vado ad analizzare la riga "0_nuovo assunto" trovo #rif! e quindi la macro non trovando il nominativo, non lo cancella.

    Allora o si sistemano le tabelle togliendo le formule e lasciando i valori (da preferire)
    o si stabilisce l'ordine di eliminazione delle righe nelle tabelle (se ne esiste uno che non interferisca)
    o si modifica la macro in maniera che se un nominativo diventa #RIF! vuol dire che va eliminato.

    probabilmente già spostando l'eliminazione dei dati dal foglio anagrafica in fondo al codice, si risolve il problema.

    saluti
    gg

  3. #3
    L'avatar di Gianfranco55
    Clicca e Apri
    Data Registrazione
    Nov 2015
    Località
    Vicenza
    Età
    62
    Messaggi
    2072
    Versione Office
    2016
    Likes ricevuti
    553
    Likes dati
    117

    Re: Eliminare righe complete su più fogli di lavoro con 1 condizione

    prova così
    Codice: 
    Private Sub Label38_Click()
    
    Dim wks As Worksheet, wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
    Dim wks4 As Worksheet, wks5 As Worksheet, wks6 As Worksheet, wks7 As Worksheet
    Dim uRiga As Long, uRiga1 As Long, uRiga2 As Long, uRiga3 As Long, uRiga4 As Long, uRiga5 As Long, uRiga6 As Long
    Dim nominativo As String
    Dim Cella As Range
    
    Set wks = Sheets("Anagrafica (2)")
    Set wks1 = Sheets("0_Nuovo assunto")
    Set wks2 = Sheets("3_SqEmergenza")
    Set wks3 = Sheets("1_Formazione Sicurezza")
    Set wks4 = Sheets("2_Aggiornamenti")
    Set wks5 = Sheets("4_Addestramento Specifico")
    Set wks6 = Sheets("1_Formaz Somm")
    Set wks7 = Sheets("Anagrafica")
     
    
    Dim Silinecek_Satir, i As Long
    Dim cevap As String
    
    If TextBox1 = "" Or TextBox2 = "" Then
    Call MsgBox("Selezionare il contatto da eliminare", vbInformation, "Avviso")
    Exit Sub
    End If
        If ListBox1.ListIndex >= 0 Then
            cevap = MsgBox("Il contatto verrà cancellato." _
            & vbCrLf & "Vuoi procedere?", vbYesNo, "Avviso")
            If cevap = vbYes Then
                
                nominativo = TextBox1 & " " & TextBox2
                '---------------------elimino nominativo del foglio "anagrafica"
                 With wks
                uRiga = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("C3:C" & uRiga)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                
               Call Aggiorna
               
                '---------------------elimino nominativo del foglio "0_Nuovo assunto"
                With wks1
                uRiga1 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A7:A" & uRiga1)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "3_SqEmergenza"
                With wks2
                uRiga2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A5:A" & uRiga2)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "1_Formazione Sicurezza"
                With wks3
                uRiga3 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A7:A" & uRiga3)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "2_Aggiornamenti"
                With wks4
                uRiga4 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A5:A" & uRiga4)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "4_Addestramento Specifico"
                With wks5
                uRiga5 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A7:A" & uRiga5)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "1_Formaz Somm"
                With wks6
                uRiga6 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("A7:A" & uRiga6)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
                '---------------------elimino nominativo del foglio "Anagrafica (2)"
                With wks7
                uRiga7 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                    With .Range("C4:C" & uRiga7)
                        Set Cella = .Find(nominativo, LookIn:=xlValues, LookAt:=xlWhole)
                        If Not Cella Is Nothing Then
                            Do
                                Cella.EntireRow.Delete
                                Set Cella = .FindNext
                            Loop While Not Cella Is Nothing
                        End If
                    End With
                End With
            End If
        End If
     End Sub

  4. I seguenti utenti hanno dato un "Like"


  5. #4
    L'avatar di G.Bove
    Clicca e Apri
    Data Registrazione
    Oct 2015
    Località
    Milano
    Età
    51
    Messaggi
    870
    Versione Office
    2010
    Likes ricevuti
    24
    Likes dati
    186

    Re: Eliminare righe complete su più fogli di lavoro con 1 condizione

    [RISOLTO]
    Gianfranco55 sei grande.

    Un grazie a tutti.

    Gene

  6. #5
    L'avatar di ggratis
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Lecce - Pisa
    Età
    45
    Messaggi
    737
    Versione Office
    Excel 2010
    Likes ricevuti
    257
    Likes dati
    215

    Re: Eliminare righe complete su più fogli di lavoro con 1 condizione

    Citazione Originariamente Scritto da G.Bove Visualizza Messaggio
    [RISOLTO]
    Gianfranco55 sei grande.

    Un grazie a tutti.

    Gene
    Gene,
    Gianfranco (che saluto) ha fatto l'inversione dei fogli (spostando in ultimo l'eliminazione dei valori dal foglio anagrafica (aggiorna i commenti per ricordartelo), ma ti consiglio comunque di correggere il db... (oppure ricordati se aggiungerai dei fogli con altri valori di celle collegati ad altri fogli che il problema ti si potrà riproporre se l'ordine di eliminazione non è corretto).

    Saluti GG

    Inviato dal mio GT-I9105P utilizzando Tapatalk

  7. #6
    L'avatar di Gianfranco55
    Clicca e Apri
    Data Registrazione
    Nov 2015
    Località
    Vicenza
    Età
    62
    Messaggi
    2072
    Versione Office
    2016
    Likes ricevuti
    553
    Likes dati
    117

    Re: Eliminare righe complete su più fogli di lavoro con 1 condizione

    Ciao
    grazie ma più che grande sono grosso

    il problema te l'aveva risolto ggratis ( ciao)

    i fogli sono in pratica dipendenti dal foglio Anagrafica attraverso la formula che ti ha segnalato ggratis

    ora se io per prima elimino la riga di Anagrafica in automatico
    si perdono tutti i riferimenti a quella riga #rif
    perciò il nome da eliminare non verrà trovato.
    ecco perché i fogli con la formula
    =SE(Anagrafica!C3<>"";Anagrafica!C3;"")

    li trovi con le righe bianche ( non trova il nome corrispondente)
    e invece dove il nome viene scritto a mano le righe vengono eliminate.

    in pratica la macro deve andare a ritroso

    ciao

Discussioni Simili

  1. [Risolto] eliminare righe doppie
    Di Chiarpato nel forum Domande su Excel VBA e MACRO
    Risposte: 4
    Ultimo Messaggio: 19/01/17, 15:59
  2. [Risolto] eliminare intera riga con condizione
    Di nessi nel forum Domande su Excel VBA e MACRO
    Risposte: 7
    Ultimo Messaggio: 30/10/16, 17:41
  3. Eliminare piu' righe contemporeanamente con macro
    Di kellington90 nel forum Domande su Excel VBA e MACRO
    Risposte: 11
    Ultimo Messaggio: 20/06/16, 19:47
  4. come eliminare righe vuote, tra righe di testo in una pagina excel
    Di francesco71 nel forum Domande su Excel in generale
    Risposte: 9
    Ultimo Messaggio: 08/05/16, 14:13
  5. Eliminare righe duplicate
    Di lala10 nel forum Domande su Excel VBA e MACRO
    Risposte: 4
    Ultimo Messaggio: 29/04/16, 14:52

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •