Объединить строковый массив как несколько критериев для фильтра - PullRequest
0 голосов
/ 25 июня 2019

Я хочу объединить строковый массив внутри автофильтра.

Я просто использовал макро-рекордер для этого кода.

Я пытаюсь получить то же самое из этого, и я не хочу перебирать все возможные условия.

 ActiveSheet.Range("$A$8:$BH$331").AutoFilter Field:=4, Criteria1:=Array( _
    "ISO 14001","ISO 45001", "ISO 9001", "OHSAS 18001", "QMET"), Operator:=xlFilterValues

Но мне нужно объединить каждый текст, если условие выполнено.

Dim strStandard(0 To 5) As String    
strStandard(0) = "ISO 9001"
strStandard(1) = "ISO 14001"
strStandard(2) = "ISO 45001"
strStandard(3) = "QMET"
strStandard(4) = "OHSAS 18001"
strStandard(5) = "Combined (14K+18K)
If ISO9001.Value = True = True Then
    ActiveSheet.Range("$A$8:$BH$331").AutoFilter Field:=4, Criteria1:=ISO9001.Value
End If
If ISO14001.Value = True = True Then
 ActiveSheet.Range("$A$8:$BH$331").AutoFilter Field:=4, Criteria1:= _
   "ISO 14001"
End If

strStandard будет множественным критерием для фильтра

Моя идея - проверять каждый флажок, если его значение равно true, если true, он получит строку из массива strStandard и передаст ее strFilterContainer для строкового массива, а затем один автофильтр

ActiveSheet.Range("$A$8:$BH$331").AutoFilter Field:=4, Criteria1:=strFilterContainer, Operator:=xlFilterValues

strStandard будет несколько критериев для фильтра Есть ли способ объединить строковый массив внутри автофильтра?

1 Ответ

0 голосов
/ 26 июня 2019

По сути, вам нужно заполнить ваш массив правильными значениями.Чтобы получить массив правильного размера, вы можете использовать ReDim или Split.

Используя Redim:

Dim MyFilters() As String, ArrayLength As Long
ArrayLength = -1
If ISO9001.Value Then
    ArrayLength = ArrayLength+1
    'Resize the array
    ReDim Preserve MyFilters(0 to ArrayLength)
    'Add option to the end of the array
    MyFilters(ArrayLength) = "ISO 9001"
End If
If ISO14001.Value Then
    ArrayLength = ArrayLength+1
    'Resize the array, without clearing contents
    ReDim Preserve MyFilters(0 to ArrayLength)
    'Add option to the end of the array
    MyFilters(ArrayLength) = "ISO 14001"
End If
If ISO45001.Value Then
    ArrayLength = ArrayLength+1
    'Resize the array, without clearing contents
    ReDim Preserve MyFilters(0 to ArrayLength)
    'Add option to the end of the array
    MyFilters(ArrayLength) = "ISO 45001"
End If
'Et Cetera

'If we have items in the Filter
If ArrayLength >= 0 Then
    'Apply the Filter
    ActiveSheet.Range("$A$8:$BH$331").AutoFilter Field:=4, _
        Criteria1:=MyFilters, Operator:=xlFilterValues
End If

Используя Split:

Dim FilterString As String
FilterString = ""

'Add the items to the string
If ISO9001.Value Then FilterString = FilterString & "|ISO 9001"
If ISO14001.Value Then FilterString = FilterString & "|ISO 14001"
If ISO45001.Value Then FilterString = FilterString & "|ISO 45001"
'Et Cetera

'If we have items in the Filter
If Len(FilterString) > 0 Then
    'Remove the first "|"
    FilterString = Mid(FilterString, 2)
    'Apply the Filter
    ActiveSheet.Range("$A$8:$BH$331").AutoFilter Field:=4, _
        Criteria1:=Split(FilterString,"|"), Operator:=xlFilterValues
End If

Лично я бы использовал Split, поскольку он менее ресурсоемкий, чем ReDim

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...