macro per filtrare

[frank_ciccioPartecipante frank_ciccio]

Ciao nel workbook allegato c'è una macro "ApplicaFiltro3" per filtrare la colonna A posizioni.

Se in cella A1 (inserisci la posizione) la sigla A1 mi seleziona tutte le celle da A1 a A14
perchè hanno tutte il numerero 1.

Se in cella A1 (inserisci la posizione) la sigla A2 mi seleziona tutte le celle da A2

Vorrei che se seleziono A1 si filtrasse solo le sigle A1

Spero di essermi spiegato.
Grazie

Allegati:

You must be logged in to view attached files.

[alexps81Moderatore alexps81 Karma: 55 pts]

Ciao, bisogna sistemare un po' di cose. La prima è pubblicare la richiesta nella sezione giusta. Per ora ci ho pensato io a spostarla in questa.

Poi per quanto riguarda il codice:

fai attenzione a come dichiari le variabili:

Dim c, avviso As String

qui solo la variabile "avviso" è di tipo string invece "c" è di tipo variant

Sempre per quanto riguarda la variabile "c", nel tuo codice prima gli assegni il valore contenuto un "A1" poi gli dici di essere uguale a quel valore prelevato e poi gli aggiungi il simbolo "*" che la rende "tutto ciò che viene anche dopo quel valore", quindi se scrivi A1 poi diventa A1, A11, A12, A13, A14, ecc...quindi non va bene, ecco perché ti filtra non solo "A1"

Il filtro poi lo devi applicare partendo dalla riga 2 e non dalla riga 3:

ActiveSheet.Range("$A$3:$A$4000").AutoFilter Field:=1, Criteria1:=c

quindi sarebbe:

ActiveSheet.Range("$A$2:$A$4000").AutoFilter Field:=1, Criteria1:=c

Il messaggio che mostri come "avviso" non ha bisogno di essere immagazzinato in un variabile, dato che poi non la utilizzi più:

avviso = MsgBox("devi inserire una posizione in A1!", vbInformation + vbOKOnly, "AVVISO")

diventa solo:

MsgBox "devi inserire una posizione in A1!", vbInformation + vbOKOnly, "AVVISO"

A questo punto prova queste modifiche:

Sub ApplicaFiltro3() 'filtro posizioni
    Dim c As String
    Dim visibili As Boolean
    
    c = Range("A1").Value
    If LCase(c) <> LCase("inserisci qui posizione da ricercare") Then
        ActiveSheet.Unprotect "123456"
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual

        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
        ActiveSheet.Range("$A$2:$A$4000").AutoFilter Field:=1, Criteria1:=c '<<< filtro
    
        On Error Resume Next
        visibili = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        On Error GoTo 0
        
        If visibili = 0 Then
            MsgBox "Nessuna corrispondenza trovata per '" & c & "'.", vbExclamation, "Filtro vuoto"
            Range("A1").ClearContents
            ActiveSheet.AutoFilterMode = False
        End If
        
        Application.Calculation = xlAutomatic
        Application.ScreenUpdating = True
        ActiveSheet.Protect "123456"
    Else
        MsgBox "devi inserire una posizione in A1!", vbInformation + vbOKOnly, "AVVISO"
    End If
End Sub

Inoltre nel Modulo di classe del Foglio4 (articoli) stavi anche scrivendo bene, aggiungendo la disabilitazione degli eventi quando modifichi qualcosa in A1. Dovevi solo sistemare meglio la sequenza delle azioni, così da evitare Loop continui e magari aggiungerci un controllo sulla cella che hai manipolato per evitare interventi inutili:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$A$1" Then Exit Sub
    
    If Range("A1") = "" Then
        Application.EnableEvents = False
        Range("A1") = "inserisci qui posizione da ricercare"
        Application.EnableEvents = True
   End If
End Sub

 

[frank_ciccioPartecipante frank_ciccio]

Grazie aleps81 la macro per filtrare funziona.

Ora il problema è per la macro per togliere i filtri

Sub TogliFiltro3()

và in errore nel metodo autofilter qui

ActiveSheet.Range("$B$2:$B$4000").AutoFilter Field:=2 'per filtro 2

non rimette tutti i filtri

[alexps81Moderatore alexps81 Karma: 55 pts]

Di tutto quello che hai scritto in quella macro ti serve solo questo:

Sub TogliFiltro3()
    ActiveSheet.Unprotect "123456"
    
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    With Range("A1")
        .ClearContents
        .Select
    End With
    ActiveSheet.Protect "123456"
End Sub

[frank_ciccioPartecipante frank_ciccio]

Grazie ancora alexps81, funziona

Ora queste 2 nuove macro le devo inserire un' altro workbook con celle unite A1:B1 e mi dà errore qui

If visibili = 0 Then
MsgBox "Nessuna corrispondenza trovata per '" & c & "'.", vbExclamation, "AVVISO"
Range("A1").ClearContents '<<<<<<<<<<<<<<<<
ActiveSheet.AutoFilterMode = False
End If
 

e qui

 

With Range("A1")
.ClearContents '<<<<<<<<<<<<<<<
.Select
End With

[alexps81Moderatore alexps81 Karma: 55 pts]

Ricorda però che il file che alleghi deve rispettare la stessa struttura di quello originale altrimenti non si finisce mai.

Hao provato a scrivere:

If visibili = 0 Then
MsgBox "Nessuna corrispondenza trovata per '" & c & "'.", vbExclamation, "AVVISO"
Range("A1:B1").ClearContents '<<<<<<<<<<<<<<<<
ActiveSheet.AutoFilterMode = False
End If

e qui:

With Range("A1:B1")
    .ClearContents '<<<<<<<<<<<<<<<
    .Select
End With

Ora scrivo da smartphone e non ho modo di verificare 

[LukeRedsPartecipante LukeReds Karma: 14 pts]

coao,

per filtrare solo quanto contenuto in A1

Sub Filtra()
With Sheets("Articoli")
    .Unprotect Password:="123456"
    .Range("A2:D3000").AutoFilter Field:=1, Criteria1:="=" & .Range("A1")
    .Protect Password:="123456"
End With
End Sub

[frank_ciccioPartecipante frank_ciccio]

Alexps81 non vedo modifiche per le celle unite

[frank_ciccioPartecipante frank_ciccio]

Lukereds la tua macro funziona

[LukeRedsPartecipante LukeReds Karma: 14 pts]

bene, allora inserisco anche quella per togliere il filtro

Sub TogliFiltro()
With Sheets("Articoli")
    .Unprotect Password:="123456"
    .Range("A2:A3000").AutoFilter Field:=1
    .Protect Password:="123456"
End With
End Sub

[frank_ciccioPartecipante frank_ciccio]

Lukereds anche la seconda macro funziona, solo un problema che toglie tutti i filtri presenti e lascia solo il filtro1.

I filtri sono fino alla colonna D

[LukeRedsPartecipante LukeReds Karma: 14 pts]

non avevo fatto caso, allo a la riga

 .Range("A2:A3000").AutoFilter Field:=1

va sostituita con 

.Range("A2:D3000").AutoFilter Field:=1

E' possibile anche che il filtro parta in automatico appena cambi codice in A1

[alexps81Moderatore alexps81 Karma: 55 pts]

Ciao Luke...solo per avvisarti che forse ti è rimasta una A in più nel filtro

LukeReds ha scritto:

.Range("A2:AD3000").AutoFilter Field:=1

[LukeRedsPartecipante LukeReds Karma: 14 pts]

Ciao Alex grazie, ho corretto

[Autore]

Articoli