AutoFilter Criteria2 - Impossibile leggere l'Array se Criteria2 è composto da date

Question

Salve,

ho più fogli con le prime colonne uguali.

Vorrei replicare con una macro i filti che ho impostato sul primo foglio anche sugli altri.

Tutto ok tranne per la colonna che contiene date.

Quando la macro inizia a processare la colonna con il filtro che contiene date, il ck in grassetto sotto genera un errore run-time.

    With Worksheets("PrimoFoglio").AutoFilter

        If .FilterMode Then

            For c = 1 To .Filters.Count

                If .Filters(c).On Then

                    If IsArray(.Filters(c).Criteria1) Then

                        For Each Value In .Filters(c).Criteria1

                            Arr(UBound(Arr)) = Mid(Value, 2, Len(Value))

                            ReDim Preserve Arr(UBound(Arr) + 1)

                        Next

                        ReDim Preserve Arr(UBound(Arr) - 1)

                    Else

                        Arr(UBound(Arr)) = .Filters(c).Criteria1

                        ReDim Preserve Arr(UBound(Arr) + 1)

                        On Error Resume Next

                        Arr(UBound(Arr)) = .Filters(c).Criteria2

                        If Err <> 0 Then ReDim Preserve Arr(UBound(Arr) - 1)

                        On Error GoTo 0

                    End If

               <omissis>

    End With

Impostando il filtro sulla data, mentre registravo una macro, si vede che il campo settato per tale scopo è Criteria2

    ActiveSheet.Range("omissis").AutoFilter Field:=12, Operator:= _

        xlFilterValues, Criteria2:=Array(0, "1/16/2020", 1, "2/22/2019", 1, "3/4/2019", 1, _

"4/29/2019", 2, "1/13/2018", 2, "1/19/2018", 2, "1/29/2018")

Ma non c'è modo (o meglio, io non l'ho trovato) per leggere tale array ed assegnarlo ad una variabile locale (in modo da poter replicare poi sugli altri fogli)... Già il solo ck "IsArray(.Filters(12).Criteria2)" mi genera un errore run-time...

Q.no sa darmi una dritta?

Grazie mille in anticipo

Piero

Answer 1

Questo legge i dati filtrati nel Foglio1 in colonna 2 e li mostra in una MsgBox:

Public Sub m()

    Dim sh As Worksheet

    Dim rng As Range

    Dim rCol As Range

    Dim c As Range

    Dim col As Collection

    Dim v As Variant

    Dim s As String

    Set sh = ThisWorkbook.Worksheets("Foglio1")

    With sh

        If .AutoFilterMode Then

Set rng = .AutoFilter.Range

            Set rCol = rng.Columns(2).SpecialCells(xlCellTypeVisible)

            On Error Resume Next

                If Err.Number = 1004 Then

                    Err.Number = 0

                Else

                    Set col = New Collection

                    For Each c In rCol

                        col.Add CStr(c.Value), CStr(c.Value)

                    Next

                    For Each v In col

                        s = s & v & ", "

                    Next

                    Set col = Nothing

                End If

            MsgBox Left(s, Len(s) - 2)

        End If

    End With

    Set c = Nothing

    Set rCol = Nothing

    Set col = Nothing

    Set rng = Nothing

    Set sh = Nothing

End Sub

Answer 2

Ciao Norman,

il codice che ha postato Mauro mi è stato effettivamente utile, ho quasi risolto.

Ma che fatica!

La parte più scocciante è che in lettura la data è DD/MM/YY, in scrittura (per settare poi il filtro sugli altri fogli) deve essere MM/DD/YY. Non ho ancora finito di scrivere tutto il codice, ma la luce in fondo al tunnel si vede...

Se però non ti costa troppo inviare il file che avevi promesso, lo guardo con piacere e attenzione.

Grazie ancora, tanto a te, quanto a Mauro.

Piero

Answer 3

Ciao Piero,

Vedo che l'interpretazione di Fratello Mauro delle tue esigenze è molto diversa dal modo in cui ho letto io la tua richiesta. Data la disparità di interpretazione, e il fatto che sia più probabile che Mauro ha mirato il tuo vero obiettivo, aspetterò i tuoi commenti in materia prima di postare il file di dimostrazione che ho promesso stamattina.

===

Regards,

Norman

Answer 4

Grazie!

Answer 5

Ciao Piero,

ho più fogli con le prime colonne uguali. 

Vorrei replicare con una macro i filti che ho impostato sul primo foglio anche sugli altri.

Tutto ok tranne per la colonna che contiene date.

Quando la macro inizia a processare la colonna con il filtro che contiene date, il ck in grassetto sotto genera un errore run-time.

    With Worksheets("PrimoFoglio").AutoFilter

        If .FilterMode Then

            For c = 1 To .Filters.Count

                If .Filters(c).On Then

                    If IsArray(.Filters(c).Criteria1) Then

                        For Each Value In .Filters(c).Criteria1

                            Arr(UBound(Arr)) = Mid(Value, 2, Len(Value))

                            ReDim Preserve Arr(UBound(Arr) + 1)

                        Next

                        ReDim Preserve Arr(UBound(Arr) - 1)

                    Else

                        Arr(UBound(Arr)) = .Filters(c).Criteria1

                        ReDim Preserve Arr(UBound(Arr) + 1)

                        On Error Resume Next

                        Arr(UBound(Arr)) = .Filters(c).Criteria2

                        If Err <> 0 Then ReDim Preserve Arr(UBound(Arr) - 1)

                        On Error GoTo 0

                    End If

               <omissis>

    End With

Impostando il filtro sulla data, mentre registravo una macro, si vede che il campo settato per tale scopo è Criteria2

    ActiveSheet.Range("omissis").AutoFilter Field:=12, Operator:= _

        xlFilterValues, Criteria2:=Array(0, "1/16/2020", 1, "2/22/2019", 1, "3/4/2019", 1, _

"4/29/2019", 2, "1/13/2018", 2, "1/19/2018", 2, "1/29/2018")

Ma non c'è modo (o meglio, io non l'ho trovato) per leggere tale array ed assegnarlo ad una variabile locale (in modo da poter replicare poi sugli altri fogli)... Già il solo ck "IsArray(.Filters(12).Criteria2)" mi genera un errore run-time...

Q.no sa darmi una dritta?

Infatti credo sia possible leggere i criteri tipo data - anche se la procedura è molto più laboriosa di quanto dovrebbe essere. Quando torno in ufficio questo pomeriggio, creerò e caricherò un file demo per te.

===

Regards,

Norman