'... With MiDato 'ActiveCell.EntireRow.Delete 'elimina riga intera Range(Cells(ActiveCell.Row, "B"), Cells(ActiveCell.Row, "K")).ClearContents 'elimina parziale End With '...
rollis13, 19/10/2021 09:06:Cambia questa parte della macro e vedi se ho capito bene la tua richiesta, così:'... With MiDato 'ActiveCell.EntireRow.Delete 'elimina riga intera Range(Cells(ActiveCell.Row, "B"), Cells(ActiveCell.Row, "K")).ClearContents 'elimina parziale End With '...
Option Explicit Sub cancellare() ' 'FGS-COMPUTACION ' Dim MiDato As Range Dim ur As Long Dim cella As Range Application.ScreenUpdating = False Set MiDato = Range("B9") With Sheets("Tabla de Datos") ur = .Range("B" & .Rows.Count).End(xlUp).Row Do Set cella = .Range("B4:B" & ur).Find(What:=MiDato, LookAt:=xlWhole, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) If Not cella Is Nothing Then .Range("B" & cella.Row & ":K" & cella.Row).ClearContents End If Loop Until cella Is Nothing End With Range("B9").Select Application.ScreenUpdating = True End Sub
rollis13, 19/10/2021 22:44:Vedi che prima di dare suggerimenti ne verifico sempre la funzionalità. Nel file che hai allegato non trovo traccia di quanto ti ho suggerito pertanto non sono in grado di dirti dove sbagli. In ogni caso, considerato che hai anche chiesto di eliminare tutte le ricorrenze del codice ricercato sostituisci l'intera macro con questa mia versione:Option Explicit Sub cancellare() ' 'FGS-COMPUTACION ' Dim MiDato As Range Dim ur As Long Dim cella As Range Application.ScreenUpdating = False Set MiDato = Range("B9") With Sheets("Tabla de Datos") ur = .Range("B" & .Rows.Count).End(xlUp).Row Do Set cella = .Range("B4:B" & ur).Find(What:=MiDato, LookAt:=xlWhole, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) If Not cella Is Nothing Then .Range("B" & cella.Row & ":K" & cella.Row).ClearContents End If Loop Until cella Is Nothing End With Range("B9").Select Application.ScreenUpdating = True End Sub
Mirko Dinelli (g_112844723855731154506), 19/10/2021 22:55: Mi da quel messaggio li errore di sintassi poi mi evidenzia quella riga li
rollis13, 19/10/2021 23:35:L'errore è generato dal copia/incolla dal Forum. Ti basta eliminare tutti i caratteri (invisibili) aggiunti; solitamente li trovi all'inizio della seconda riga, quella segnalata in rosso. Cancella tutto il vuoto davanti alle due righe per andare (quasi) sul sicuro.
rollis13, 20/10/2021 08:14:No, mi dispiace, ma ho una vecchia linea internet a consumo e caricare file mi costa una 'botta'.
Option Explicit Sub cancellare() ' 'FGS-COMPUTACION ' Dim MiDato As Range Dim ur As Long Dim riga As Long Dim cella As Range Application.ScreenUpdating = False Set MiDato = Range("B9") If MiDato = "" Then MsgBox "Devi indicare un PIUMONE Nº" Exit Sub End If With Sheets("Tabla de Datos") ur = .Range("B" & .Rows.Count).End(xlUp).Row riga = 4 Do Set cella = .Range("B4:B" & ur).Find(What:=MiDato, LookAt:=xlWhole, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) If Not cella Is Nothing Then .Range("B" & cella.Row & ":K" & cella.Row).ClearContents End If riga = riga + 1 Loop Until (cella Is Nothing And riga > ur) ur = .Range("A" & .Rows.Count).End(xlUp).Row .Sort.SortFields.Clear .Sort.SortFields.Add2 Key:=.Range("B4:B" & ur), SortOn:=xlSortOnValues, Order:=xlAscending .Sort.SortFields.Add2 Key:=.Range("C4:C" & ur), SortOn:=xlSortOnValues, Order:=xlDescending With .Sort .SetRange Range("B4:K" & ur) .Header = xlGuess .Apply End With End With Range("B9").Select Application.ScreenUpdating = True MsgBox "Fatto, cancellato PIUMONE Nº " & MiDato End Sub
rollis13, 21/10/2021 19:28:Vediamo se con queste modifiche alle macro si ottiene il risultato che hai chiesto:Option Explicit Sub cancellare() ' 'FGS-COMPUTACION ' Dim MiDato As Range Dim ur As Long Dim riga As Long Dim cella As Range Application.ScreenUpdating = False Set MiDato = Range("B9") If MiDato = "" Then MsgBox "Devi indicare un PIUMONE Nº" Exit Sub End If With Sheets("Tabla de Datos") ur = .Range("B" & .Rows.Count).End(xlUp).Row riga = 4 Do Set cella = .Range("B4:B" & ur).Find(What:=MiDato, LookAt:=xlWhole, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) If Not cella Is Nothing Then .Range("B" & cella.Row & ":K" & cella.Row).ClearContents End If riga = riga + 1 Loop Until (cella Is Nothing And riga > ur) ur = .Range("A" & .Rows.Count).End(xlUp).Row .Sort.SortFields.Clear .Sort.SortFields.Add2 Key:=.Range("B4:B" & ur), SortOn:=xlSortOnValues, Order:=xlAscending .Sort.SortFields.Add2 Key:=.Range("C4:C" & ur), SortOn:=xlSortOnValues, Order:=xlDescending With .Sort .SetRange Range("B4:K" & ur) .Header = xlGuess .Apply End With End With Range("B9").Select Application.ScreenUpdating = True MsgBox "Fatto, cancellato PIUMONE Nº " & MiDato End Sub
rollis13, 21/10/2021 21:49:Quello che vedi nella macro è la diagnostica a video che comparirà in caso di errore e/o alla fine della cancellazione; nella macro non devi fare niente, al massimo puoi cambiare il testo tra le doppie-virgolette nel caso non ti piaccia quanto ho proposto come testo.
rollis13, 21/10/2021 22:52:Veramente ho scritto il codice parola per parola aggiungendo o adattando quanto avevi già proposto. Per i video non saprei, sicuramente in rete ci sono, personalmente ho iniziato tanti anni fa leggendo e facendo pratica su libri spessi 3 dita e facendo le ore piccole fino a quando non ho imparato la sinstassi e l'uso delle funzioni; magari sono stato anche facilitato essendomi fatto il mazzo a scuola per imparare bene l'inglese.