Добавление динамического изменения значений ячеек в массив автофильтров в VBA - PullRequest
Новая
       7

Добавление динамического изменения значений ячеек в массив автофильтров в VBA

0 голосов
/ 06 мая 2018

В Sheet1 на листе Excel у меня в Range ("B6") у меня есть код, так что это может быть один код в этом месяце, но это может быть еще 3 кода, добавленных ниже в следующем, и это просто может быть два новых в следующем месяце, поэтому значения будут продолжать меняться, и число может варьироваться от 1 до всего, что будет динамическим. На основании этих значений на следующем листе 2 необходимо отфильтровать дату. Итак, в Sheet2 у меня есть три столбца, один - Sl_No. один ME_Code (это то, что нужно отфильтровать на основе данных листа 1) и цены

Итак, я новичок в VBA и попробовал приведенный ниже код, который не работает при наличии нескольких кодов, которые я пытаюсь добавить в массив автофильтров в VBA.

Вот мой код, который не работает, когда я пытаюсь использовать опцию else. Может ли кто-нибудь помочь мне, я пробовал несколько опций из самого StackOverflow, но не работал

Вот мой код, 

Sub ToCheckArray()

Dim N As Long

Worksheets("Sheet1").Select
If IsEmpty(Range("B6").Offset(1, 0).Value) Then
    Worksheets("Sheet1").Select
    arr1 = Array(Range("B6"))
    Worksheets("Sheet2").Select
    Range("A1:C1").AutoFilter field:=2, Criteria1:=arr1, Operator:=xlFilterValues
Else
    Worksheets("Sheet1").Select
    'With Sheets("Sheet1")
        'N = .Cells(Rows.Count, "B").End(xlDown).Row
        'ReDim ary(6 To N)
        'For i = 6 To N
            'ary(i) = .Cells(i, 1)
        'Next i
    'End With

    arr1 = Array(Range("B6", Range("B6").End(xlDown)))
    Worksheets("Sheet2").Select
    Range("A1:C1").AutoFilter field:=2, Criteria1:=ary, operator:=xlFilterValues
End If

End Sub

1 Ответ

0 голосов
/ 06 мая 2018

Используйте 

Else
    Dim ary As Variant
    With Worksheets("Sheet1")
        ary = Application.Transpose(.Range("B6", .Cells(Rows.Count, "B").End(xlDown)).Value)
    End With
    Worksheets("Sheet2").Range("A1:C1").AutoFilter field:=2, Criteria1:=ary, operator:=xlFilterValues
End If

Как вы видите, я избегал оператора Select вместо полной ссылки на диапазон до ссылки на лист

Таким образом, весь ваш код можно переписать следующим образом: 

Sub ToCheckArray()
    Dim ary As Variant

    With Worksheets("Sheet1")
        If IsEmpty(.Range("B6").Offset(1, 0).Value) Then
            ary = Array(.Range("B6").Value)
        Else
            ary = Application.Transpose(.Range("B6", .Cells(Rows.Count, "B").End(xlDown)).Value
        End If
    End With
    Worksheets("Sheet2").Range("A1:C1").AutoFilter field:=2, Criteria1:=ary, Operator:=xlFilterValues
End Sub

И если вы уверены, что Sheet1 всегда имеет значение в B6, и возможные другие значения следуют за ним до последней непустой ячейки в столбце B, тогда он может свернуться до: 

Sub ToCheckArray()
    Dim ary As Variant

    With Worksheets("Sheet1")
        ary = Application.Transpose(.Range("B6", .Cells(Rows.Count, "B").End(xlUp)).Value
    End With
    Worksheets("Sheet2").Range("A1:C1").AutoFilter field:=2, Criteria1:=ary, Operator:=xlFilterValues
End Sub
...