Macro filtra dati

Hai un problema con Excel?

Nuova discussione

Macro filtra dati
di ghost69le data: 19/01/2016 16:03:50
Buongiorno,
sono nuovo del forum,ho creato la seguente macro con registra macro:

Tutti i filtri si attivano nel momento in cui lancio tale macro.

Io invece vorrei che, ciò che cerco nella cella B3 (Range "B3"), se trovato, nel Range("$B$5:$H$12"), attivasse solo il flitro della colonna in cui trova i risultati, e cioè o il filtro 1 o il 2 o il 4.

Spero possiate aiutarmi.
Grazie

Sub cerca()
'
' Macro1 Macro
'


    ActiveSheet.Range("$B$5:$H$12").AutoFilter Field:=1, Criteria1:=Range("B3")
    
    ActiveSheet.Range("$B$5:$H$12").AutoFilter Field:=2, Criteria1:=Range("B3")
  
    ActiveSheet.Range("$B$5:$H$12").AutoFilter Field:=4, Criteria1:=Range("B3")
    
    
End Sub

di Raffaele53 data: 19/01/2016 20:50:15
Puoi spostare un allegato?
di ghost69le data: 19/01/2016 21:21:21
Ho allegato un file esempio!
di ghost69le (utente non iscritto) data: 20/01/2016 08:44:09
Postato!

di Raffaele53 data: 20/01/2016 16:50:04
Da provare

Option Explicit
Sub cerca()
If Application.WorksheetFunction.CountIf(Range("$B$5:$B$12"), Range("B3").Value) <> 0 Then
    ActiveSheet.Range("$B$5:$H$12").AutoFilter Field:=1, Criteria1:=Range("B3")
ElseIf Application.WorksheetFunction.CountIf(Range("$C$5:$C$12"), Range("B3").Value) <> 0 Then
    ActiveSheet.Range("$B$5:$H$12").AutoFilter Field:=2, Criteria1:=Range("B3")
ElseIf Application.WorksheetFunction.CountIf(Range("$E$5:$E$12"), Range("B3").Value) <> 0 Then
    ActiveSheet.Range("$B$5:$H$12").AutoFilter Field:=4, Criteria1:=Range("B3")
Else
    MsgBox "non trovato"
End If
End Sub

di scossa data: 21/01/2016 13:18:21
Il codice sotto fa quello che chiedi (allego file modificato: "Macro Excel Select Case.xlsm")

scossa's web site

Se tu hai una mela, ed io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

Sub dovadola()

  Dim rng As Range
  Dim nRows As Long
  Dim vWhat As Variant
  
  Application.ScreenUpdating = False
  vWhat = ActiveSheet.Range("B3")
  Set rng = ActiveSheet.Range("$B$5:$H$12")
  With rng
    If .Parent.FilterMode Then
      .Parent.AutoFilter.ShowAllData
      .Parent.Shapes("Rounded Rectangle 1").DrawingObject.Caption = "cerca"
    Else
      .Parent.Shapes("Rounded Rectangle 1").DrawingObject.Caption = "mostra tutto"
      .AutoFilter Field:=1, Criteria1:=vWhat
      If .SpecialCells(xlCellTypeVisible).Rows.Count * .SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
        .AutoFilter Field:=1
        .AutoFilter Field:=2, Criteria1:=vWhat
        If .SpecialCells(xlCellTypeVisible).Rows.Count * .SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
          .AutoFilter Field:=2
          .AutoFilter Field:=4, Criteria1:=vWhat
          If .SpecialCells(xlCellTypeVisible).Rows.Count * .SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
            .AutoFilter Field:=4
            .Parent.Shapes("Rounded Rectangle 1").DrawingObject.Caption = "cerca"
            Application.ScreenUpdating = True
            MsgBox "nessuna corrispondenza"
          End If
        End If
      End If
    End If
  End With
  Application.ScreenUpdating = True
  Set rng = Nothing
End Sub

di ghost69 (utente non iscritto) data: 21/01/2016 15:13:12
Buonasera e grazie per le risposte.
Le 2 macro sono entrambe funzionati.

Se volessi che la ricerca partisse solo con le iniziali del nome, ad esempio nella cella ("B3"), invece di cercare col nome "auto" cerco solo con le iniziali "au", dovrei aggiungere al Range("B3") questo:
&"*" giusto?
Ho provato a farlo ma non va, dove sbaglio?
Questa singola macro funziona inserendo solo le iniziali del nome da cercare: Sub cerca() ActiveSheet.Range("$B$5:$H$12").AutoFilter Field:=1, Criteria1:=Range("B3") & "*" End Sub

di Raffaele53 data: 21/01/2016 16:28:23
La mia diventerebbe così
Però se cerchi (auto) con "au" e nella colonna precedente esiste "autista", estrae quello.
Ho messo un controllo per maiuscole/minuscole

Option Explicit
Option Compare Text
Sub cerca()
If Application.WorksheetFunction.CountIf(Range("$B$5:$B$12"), Range("B3").Value & "*") <> 0 Then
    ActiveSheet.Range("$B$5:$H$12").AutoFilter Field:=1, Criteria1:=Range("B3") & "*"
ElseIf Application.WorksheetFunction.CountIf(Range("$C$5:$C$12"), Range("B3").Value & "*") <> 0 Then
    ActiveSheet.Range("$B$5:$H$12").AutoFilter Field:=2, Criteria1:=Range("B3") & "*"
ElseIf Application.WorksheetFunction.CountIf(Range("$E$5:$E$12"), Range("B3").Value & "*") <> 0 Then
    ActiveSheet.Range("$B$5:$H$12").AutoFilter Field:=4, Criteria1:=Range("B3") & "*"
Else
    MsgBox "non trovato"
End If
End Sub

di ghost69 (utente non iscritto) data: 22/01/2016 07:08:14
Grazie funzionano in utte benissimo.

Vuoi Approfondire?