VBA, есть ли способ проверить, равно ли значение любому значению внутри массива? - PullRequest
0 голосов
/ 04 января 2019

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

Я использовал простое условие, чтобы текущее значение не совпадало с предыдущим, но я не могу найти решение для повторяющихся значений в целом.

        If k > 0 Then
            If arrA(k) = arrA(k - 1) Then
                arrA(k) = ""
                k = k - 1
            End If
        End If

1 Ответ

0 голосов
/ 06 января 2019

Метод повторной фильтрации

Просто ради искусства, я демонстрирую подход через ► повторную фильтрацию (т.е. без использования словаря или коллекции - вы найдете множество dict / coll примеров в SO: -):

Пример кода

В этом примере предполагается, что строковые значения проверяются на наличие дубликатов (с использованием чувствительности к регистру при повторной фильтрации хитрым способом - см. Аргумент vbBinaryCompare в Filter функции) и сопоставление текущей позиции индекса (idx) каждого поисковый запрос.

Option Explicit                     ' declaration head of code module
Sub DupEx()
' Purpose: delete subsequent string duplicates in array
' Method:  repeated filter function using match to get index position
' Site:    /10003556/vba-est-li-sposob-proverit-ravno-li-znachenie-lybomu-znacheniy-vnutri-massiva
' Author:  T.M. (https://stackoverflow.com/users/6460297/t-m)
  Dim arrA(), i&, idx&, flt, searched
' example string values (change to wanted values)
  arrA = Array("zero", "one", "two", "two", "three", "two", "four", "zero", "four", "three", "five", "five")
  flt = arrA
  Debug.Print "Original array counts " & UBound(flt) + 1 & " elements: " & Chr(34) & Join(flt, ", ") & Chr(34)
  For i = LBound(arrA) To UBound(arrA)
      searched = arrA(i)                                      ' define search term
      If UBound(Filter(flt, searched, True, vbBinaryCompare)) > 0 Then
         '[1] change first occurrence of search term to temporary dummy (to avoid later deletion)
          On Error Resume Next
          idx = Application.Match(searched, flt, False) - 1    ' deduct 1 as match result is one based
          flt(idx) = ChrW(&H2999)                              ' change to temporary dummy value
         '[2] execute filter (3rd argument=False DELETES each subsequent search value in flt array)
         '    [Caveat: this example deletes partial string findings as well !]
          flt = Filter(flt, searched, False, vbBinaryCompare)
         '[3] restore first occurrence back to old value
          flt(idx) = searched
      End If
  Next i
  Debug.Print "Filtered array counts " & UBound(flt) + 1 & " elements: " & Chr(34) & Join(flt, ", ") & Chr(34)
  'arrA = flt                                                   ' overwrite original array
End Sub

Результат отладки.Печать, как показано в непосредственном окне Редактор Visual Basic (VBE)

  Original array counts 12 elements: "zero, one, two, two, three, two, four, zero, four, three, five, five"
  Filtered array counts 6 elements:  "zero, one, two, three, four, five"
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...