Riga di codice per filtrare solo le righe con data senza formule

tanimon, 08/06/2018 19.17:

---

ciao,
non ho guardatoil file,
ma dopo avere applicato il filtro dove sono i duplicati,

prova questa da mettere in un modulo standard e a cui abbinare un pulsante

Dim priga As Long
Dim uriga As Long

uriga = Range("A" & Rows.Count).End(xlUp).Row
priga = Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeVisible).Row

Range(Cells(priga + 1, 1), Cells(uriga, 1)).EntireRow.Delete

Range("A2").Activate
Range("A2").AutoFilter

rimane solo 1 riga filtrata

ciao
Frank

---

sputnik_r, 6/8/2018 6:49 PM:

---

Buona sera.

Qualcuno ha gentilmente una riga di codice che abbinerei a un pulsante per filtrare ed eliminare solo le date doppie/triple/quadruple di un n° di righe variabile in base a quante date hanno duplicato con solo "valori senza formule" ?

---

raffaele1953, 09/06/2018 00.47:

---

Un saluto a tanimon
Un saluto a GiuseppeMN

Oltre alla richiesta bisogna anche cercare di spiegarsi al meglio
Solo dopo aver visto l'allegato, forse ho capito cosa intendi per DATE + "valori senza formule"
Tu desideri che tutte le Date NON create da formule siano ...eliminate. Intendevi cancellate oppure eliminata la riga?
FarTi il codice "per eliminare righe" sulla colonna B, non và bene (riga4 e dopo riga403 ci sono dei dati)
Per fortuna hai la colonna A che è similare. PS. se esegui il codice sulla colonna B cambiare Cells(X, 1) in Cells(X, 2)
NB. La riga verde, sceglie nelle celle se sono presenti dati oppure formule (per la colonna A non serve)

Sub Elimina()
Dim Ur As Long, X As Long
Ur = Range("A" & Rows.Count).End(xlUp).Row
For X = Ur To 5 Step -1
If Cells(X, 1) = "" Then Rows(X & ":" & X).Delete
'If Mid(Cells(X, 1).Formula, 1, 1) <> "=" Then Rows(X & ":" & X).Delete
Next X
MsgBox "fatto"
End Sub

---

raffaele1953, 09/06/2018 10.10:

---

Questo codice filtra le Date (B) senza formule, l'altro le fa rivedere nuovamente

vb

Sub nascondi()
Dim Ur As Long, X As Long
Ur = Range("B" & Rows.Count).End(xlUp).Row
For X = Ur To 5 Step -1
If Mid(Cells(X, 2).Formula, 1, 1) = "=" Then Rows(X & ":" & X).Hidden = True
Next X
MsgBox "fatto"
End Sub

Sub scopri()
Rows("1:65536").Hidden = False
End Sub

---

GiuseppeMN, 09/06/2018 11.48:

---

Buona giornata, sputnik_r;
mi sembra di capire che hai risolto ma, perdonami, visto che già avevo eseguito alcuni test, mi permetto di proporti questa alternativa.

Tre Pulsanti
- Visualizza Dataset; consente di visualizzare tutti Record
- Filtra Date duplicate; esegue un Filtro su tutte le date duplicate
- Elimina Date duplicate

Dopo aver attivato il Pulsante "Filtra Date duplicate" inserisci un Flag(un Carattere a tuo piacere) nella Colonna "I" della Data che, successivamente, vuoi eliminare.

A questo punto, attivando il Pulsante "Elimina Date duplicate" consenti, solo ai Colleghi che hai autorizzato, di eliminare le Date selezionate; attualmente la password d'accesso alla Procedura è "123" che, ovviamente modificherai a tuo piacere.

Option Explicit
Const Psw As String = "123"

Sub Visualizza_DataSet()
Dim Nrc As Long
    
    Nrc = Range("B" & Rows.Count).End(xlUp).Row
        Columns("B:B").EntireRow.Hidden = False
    Cells(2, 2).Select
End Sub

Sub Filtra_Date_duplicate()
Application.ScreenUpdating = False
Dim Nrc As Long, x As Long
    
    Nrc = Range("B" & Rows.Count).End(xlUp).Row
        Call Visualizza_DataSet
            Range(Cells(4, 1), Cells(Nrc, 1)).EntireRow.Hidden = True
        For x = Nrc To 4 Step -1
            If Cells(x, 2).Value = Cells(x - 1, 2).Value Then Cells(x, 2).EntireRow.Hidden = False
        Next x
Application.ScreenUpdating = True
End Sub

Sub Elimina_Date_duplicate()
Dim Titolo As String, Messaggio As String, Default As String, PswA As String
    Titolo = "Protezione Codice ''Elimina Date duplicate"    ' Definisce il titolo.
    Messaggio = "Per accedere a questa Funzione, devi inserire la Password di autenticazione"
    Default = ""
        PswA = Application.InputBox(Messaggio, Titolo, Default)
    If PswA <> Psw Then
        MsgBox "La Password" & Chr(10) & PswA & Chr(10) _
        & "non è corretta; chiedi autorizzazione al Responsabile."
            End
    End If
Application.ScreenUpdating = False
Dim Nrc As Long, x As Long
    
    Call Visualizza_DataSet
    Nrc = Range("B" & Rows.Count).End(xlUp).Row
        For x = Nrc To 4 Step -1
            If Cells(x, 9).Value <> "" Then Cells(x, 2).EntireRow.Delete
        Next x
Application.ScreenUpdating = True
End Sub

A disposizione.

Buon fine settimana.

Giuseppe

---

GiuseppeMN, 09/06/2018 17.45:

---

Buona sera, sputnik_r;
riesco a risponderti solo ora.

Ritenendo farti cosa gradita, allego il File con il quale ho condotto i miei Test.

Nel File trovi solo due Fogli di lavoro:
-    Base per Test; andrà eliminato alla fine dei Test
-    Turnazione_Organico; il tuo reale Foglio di lavoro

"Base per Test" mi è servito esclusivamente per riportare alle origini "Turnazione_Organico" e quindi poter eseguire nuovi Test.



A disposizione.

Buon fine settimana.

Giuseppe

---

GiuseppeMN, 10/06/2018 07.08:

---

Buona giornata, sputnik_r;
molto bene,considera solo che, nelle mie intenzioni, la Password era dichiarata come "Costante" in:

Option Explicit
Const Psw As String = "123"

Voglio dire, modificando "123" con la tua Password dovrebbe funzionare senza aggiungere altre istruzioni.



A disposizione.

Giuseppe

---

GiuseppeMN, 10/06/2018 07.08:

---

Buona giornata, sputnik_r;
molto bene,considera solo che, nelle mie intenzioni, la Password era dichiarata come "Costante" in:

Option Explicit
Const Psw As String = "123"

Voglio dire, modificando "123" con la tua Password dovrebbe funzionare senza aggiungere altre istruzioni.



A disposizione.

Giuseppe

---

sputnik_r, 10/06/2018 07.23:

---

Cambiando quella da 123 a mia psw da sola non funziona, mettendo anche quelle che ho postato su per ogni istruzione pare di sì.


Ma devo provare meglio

---