Удалить один массив из большего? - PullRequest
0 голосов
/ 17 апреля 2019

У меня есть два массива в VBA, и я пытаюсь получить третий подмассив, вычитающий эти массивы, что-то вроде этого:

Оригинальные массивы:

array1=("A","B","C","D")
array2=("B","C")

Ожидаемый результат:


array1-array2=("A","D")

Есть ли способ достичь этого?

Ответы [ 3 ]

0 голосов
/ 17 апреля 2019

TBH, я обычно нахожу Функция фильтра VBA почти бесполезной для повседневных требований программирования и редко использую ее, но в этом случае она кажется идеально подходящей для ваших целей, если вы установите опциональный третий [include / exclude] аргумент False.

В следующем предполагается, что вы хотите сохранить исходные значения в array1, поэтому копия оригиналов делается в array3, где толькоЗначения исключения сохраняются.Я также использовал vbTextCompare вместо vbBinaryCompare для операции фильтрации без учета регистра.Измените значение на vbBinaryCompare для чувствительной к регистру операции.

Option Explicit

Sub arrayDiff()

    Dim i As Long
    Dim array1 As Variant, array2 As Variant, array3 As Variant

    'populate array1 and array2
    array1 = Array("A", "B", "C", "D")
    array2 = Array("B", "C")

    'make a working copy of array1 to process
    array3 = array1

    'loop through the elements in array2 and remove them from array3
    For i = LBound(array2) To UBound(array2)
        array3 = Filter(array3, array2(i), False, vbTextCompare)
    Next i

    'display results in Immediate window
    Debug.Print "array3 = Array(""" & Join(array3, """,""") & """)"

    'alternate result display
    For i = LBound(array3) To UBound(array3)
        Debug.Print array3(i)
    Next i

End Sub

'results from Immediate window
array3 = Array("A","D")
A
D
0 голосов
/ 17 апреля 2019

Вы можете использовать словарь для создания функции, которая будет возвращать массив, состоящий из array1 - элементы array2:

Option Explicit
Function arrSubtr(arr1, arr2)
    Dim D As Dictionary
    Dim V

Set D = New Dictionary
    D.CompareMode = TextCompare

For Each V In arr1
    D.Add V, V
Next V

For Each V In arr2
    If D.Exists(V) Then
        D.Remove (V)

'    Uncomment below if you want to add in items in
'    array2 that don't exist in array1
'    Else
'        D.Add V, V
    End If
Next V

arrSubtr = D.Keys

End Function
0 голосов
/ 17 апреля 2019

цикл первого массива и использование Application.Match для поиска во втором массиве.

Загрузка третьего массива с теми элементами, которые выдают ошибку из совпадения:

Sub try()
    Dim array1()
    array1 = Array("A", "B", "C", "D")

    Dim array2()
    array2 = Array("B", "C")

    Dim array3()
    ReDim array3(0)

    Dim i As Long
    For i = LBound(array1) To UBound(array1)            
        If IsError(Application.Match(array1(i), array2, 0)) Then
            array3(UBound(array3)) = array1(i)
            ReDim Preserve array3(UBound(array3) + 1)
        End If
    Next i

    ReDim Preserve array3(UBound(array3) - 1)

    Debug.Print Join(array3, ",")

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