Загрузка массива только с уникальными значениями

Question

У меня есть диапазон, через который я зацикливаюсь в VBA:

For Lrow = Firstrow To Lastrow Step 1
        With .Cells(Lrow, "E")
            If Not IsError(.Value) Then

            End If
        End With
    Next Lrow

В пределах этого оператора if мне нужно загружать массив с каждым значением только один раз

MB-NMB-ILAMB-НМБ-ILAMB-НМБ-STPMB-НМБ-STPMB-НМБ-WASMB-НМБ-WASMB-НМБ-WAS

Так что для массива мне нужны только MB-NMB-ILA, MB-NMB-STP и MB-NMB-WAS

Может кто-нибудь мне помочь, мой мозг не работает правильнов понедельник!Спасибо

Answer 1

Вы можете использовать фильтр, чтобы проверить, существует ли что-то в массиве.

Dim arr As Variant: arr = Array("test1", "test2", "test3")
If UBound(Filter(arr, "blah")) > -1 Then
    Debug.Print "it is in the array"
Else
    Debug.Print "it's not in the array"
End If

Вы также можете использовать коллекцию и написать подпрограмму для добавления только уникальных элементов в коллекцию

Dim col As New Collection
Sub addIfUnique(sAdd As String)
    Dim bAdd As Boolean: bAdd = True
    If col.Count > 0 Then
        Dim iCol As Integer
        For iCol = 1 To col.Count
            If LCase(col(iCol)) = LCase(sAdd) Then
                bAdd = False
                Exit For
            End If
        Next iCol
    End If
    If bAdd Then col.Add sAdd
End Sub
Private Sub Command1_Click()
    Dim a As Integer
    Dim b As Integer
    For a = 1 To 10
        addIfUnique "item " & a
        For b = 1 To 10
            addIfUnique "item " & b
        Next b
    Next a
    For a = 1 To col.Count
        Debug.Print col(a)
    Next a
End Sub

Answer 2

Предположим, у меня есть следующее в ячейках от A1 до A5 и я хочу получить массив уникальных значений, т.е. {a, b, c, d}

        A
1      "a"
2      "b"
3      "c"
4      "c"
5      "d"

Следующие два фрагмента кода помогут достичь этого:

CreateUniqueArray - получить значение val из каждой ячейки и добавить в массив, если его еще нет в массиве

IsInArray - служебная функция для проверки значения в массиве путем выполнения простого цикла

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

Sub Test()
    Dim firstRow As Integer, lastRow As Integer, cnt As Integer, iCell As Integer
    Dim myArray()
    cnt = 0
    firstRow = 1
    lastRow = 10

    For iCell = firstRow To lastRow
        If Not IsInArray(myArray, Cells(iCell, 1)) Then
            ReDim Preserve myArray(cnt)
            myArray(cnt) = Cells(iCell, 1)
            cnt = cnt + 1
        End If
    Next iCell
End Sub

Function IsInArray(myArray As Variant, val As String) As Boolean
    Dim i As Integer, found As Boolean
    found = False

    If Not Len(Join(myArray)) > 0 Then
        found = False
    Else
        For i = 0 To UBound(myArray)
            If myArray(i) = val Then
               found = True
            End If
        Next i
    End If
    IsInArray = found
End Function