Есть ли встроенная функция vba для получения уникальных значений из одномерного массива? как насчет того, чтобы просто избавиться от дубликатов?
Если нет, тогда как я получу уникальные значения из массива?
Есть ли встроенная функция vba для получения уникальных значений из одномерного массива? как насчет того, чтобы просто избавиться от дубликатов?
Если нет, тогда как я получу уникальные значения из массива?
Этот пост содержит 2 примера. Мне нравится второй:
Sub unique()
Dim arr As New Collection, a
Dim aFirstArray() As Variant
Dim i As Long
aFirstArray() = Array("Banana", "Apple", "Orange", "Tomato", "Apple", _
"Lemon", "Lime", "Lime", "Apple")
On Error Resume Next
For Each a In aFirstArray
arr.Add a, a
Next
For i = 1 To arr.Count
Cells(i, 1) = arr(i)
Next
End Sub
Нет встроенных функций для удаления дубликатов из массивов. Ответ Raj кажется элегантным, но я предпочитаю использовать словари.
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
'Set d = New Scripting.Dictionary
Dim i As Long
For i = LBound(myArray) To UBound(myArray)
d(myArray(i)) = 1
Next i
Dim v As Variant
For Each v In d.Keys()
'd.Keys() is a Variant array of the unique values in myArray.
'v will iterate through each of them.
Next v
EDIT: я изменил цикл, чтобы использовать LBound
и UBound
в соответствии с предлагаемым Томалаком ответом.
EDIT: d.Keys()
- это массив Variant, а не коллекция.
Я создал гораздо более тщательные тесты. Во-первых, как указал @ChaimG, раннее связывание имеет большое значение (я изначально использовал код @eksortso выше дословно, который использует позднее связывание). Во-вторых, мои исходные тесты включали только время для создания уникального объекта, однако он не проверял эффективность использования объекта. Моя цель в этом заключается в том, чтобы на самом деле не имело значения, смогу ли я создать объект очень быстро, если созданный мной объект неуклюж и замедляет движение вперед.
Старое замечание: оказывается, что зацикливание на объекте коллекции крайне неэффективно
Оказывается, что цикл по коллекции может быть достаточно эффективным, если вы знаете, как это сделать (я не знал). Как отметил @ChaimG (еще раз) в комментариях, использование конструкции For Each
нелепо превосходит простое использование цикла For
. Чтобы дать вам представление о том, что перед изменением конструкции цикла время для Collection2
для Test Case Size = 10^6
было более 1400 с (т.е. ~ 23 минуты). Теперь это скудные 0,195 с (более чем в 7000 раз быстрее).
Для метода Collection
есть два раза. Первый (мой оригинальный тест Collection1
) показывает время создания уникального объекта. Вторая часть (Collection2
) показывает время для цикла по объекту (что очень естественно) для создания возвращаемого массива, как это делают другие функции.
На приведенной ниже диаграмме желтый фон указывает, что он был самым быстрым для этого теста, а красный - самым медленным (алгоритмы "не проверены" исключены). Общее время для метода Collection
является суммой Collection1
и Collection2
. Бирюзовый указывает, что это был самый быстрый независимо от первоначального порядка.
Ниже приведен оригинальный алгоритм, который я создал (я немного его изменил, например, я больше не создаю экземпляр своего собственного типа данных). Он возвращает уникальные значения массива с исходным порядком за очень респектабельное время и может быть изменен для получения любого типа данных. За пределами IndexMethod
это самый быстрый алгоритм для очень больших массивов.
Вот основные идеи этого алгоритма:
Ниже приведен пример:
Let myArray = (86, 100, 33, 19, 33, 703, 19, 100, 703, 19)
1. (86, 100, 33, 19, 33, 703, 19, 100, 703, 19)
(1 , 2, 3, 4, 5, 6, 7, 8, 9, 10) <<-- Indexing
2. (19, 19, 19, 33, 33, 86, 100, 100, 703, 703) <<-- sort by values
(4, 7, 10, 3, 5, 1, 2, 8, 6, 9)
3. (19, 33, 86, 100, 703) <<-- remove duplicates
(4, 3, 1, 2, 6)
4. (86, 100, 33, 19, 703)
( 1, 2, 3, 4, 6) <<-- sort by index
Вот код:
Function SortingUniqueTest(ByRef myArray() As Long, bOrigIndex As Boolean) As Variant
Dim MyUniqueArr() As Long, i As Long, intInd As Integer
Dim StrtTime As Double, Endtime As Double, HighB As Long, LowB As Long
LowB = LBound(myArray): HighB = UBound(myArray)
ReDim MyUniqueArr(1 To 2, LowB To HighB)
intInd = 1 - LowB 'Guarantees the indices span 1 to Lim
For i = LowB To HighB
MyUniqueArr(1, i) = myArray(i)
MyUniqueArr(2, i) = i + intInd
Next i
QSLong2D MyUniqueArr, 1, LBound(MyUniqueArr, 2), UBound(MyUniqueArr, 2), 2
Call UniqueArray2D(MyUniqueArr)
If bOrigIndex Then QSLong2D MyUniqueArr, 2, LBound(MyUniqueArr, 2), UBound(MyUniqueArr, 2), 2
SortingUniqueTest = MyUniqueArr()
End Function
Public Sub UniqueArray2D(ByRef myArray() As Long)
Dim i As Long, j As Long, Count As Long, Count1 As Long, DuplicateArr() As Long
Dim lngTemp As Long, HighB As Long, LowB As Long
LowB = LBound(myArray, 2): Count = LowB: i = LowB: HighB = UBound(myArray, 2)
Do While i < HighB
j = i + 1
If myArray(1, i) = myArray(1, j) Then
Do While myArray(1, i) = myArray(1, j)
ReDim Preserve DuplicateArr(1 To Count)
DuplicateArr(Count) = j
Count = Count + 1
j = j + 1
If j > HighB Then Exit Do
Loop
QSLong2D myArray, 2, i, j - 1, 2
End If
i = j
Loop
Count1 = HighB
If Count > 1 Then
For i = UBound(DuplicateArr) To LBound(DuplicateArr) Step -1
myArray(1, DuplicateArr(i)) = myArray(1, Count1)
myArray(2, DuplicateArr(i)) = myArray(2, Count1)
Count1 = Count1 - 1
ReDim Preserve myArray(1 To 2, LowB To Count1)
Next i
End If
End Sub
Вот алгоритм сортировки, который я использую (подробнее об этом алгоритме здесь).
Sub QSLong2D(ByRef saArray() As Long, bytDim As Byte, lLow1 As Long, lHigh1 As Long, bytNum As Byte)
Dim lLow2 As Long, lHigh2 As Long
Dim sKey As Long, sSwap As Long, i As Byte
On Error GoTo ErrorExit
If IsMissing(lLow1) Then lLow1 = LBound(saArray, bytDim)
If IsMissing(lHigh1) Then lHigh1 = UBound(saArray, bytDim)
lLow2 = lLow1
lHigh2 = lHigh1
sKey = saArray(bytDim, (lLow1 + lHigh1) \ 2)
Do While lLow2 < lHigh2
Do While saArray(bytDim, lLow2) < sKey And lLow2 < lHigh1: lLow2 = lLow2 + 1: Loop
Do While saArray(bytDim, lHigh2) > sKey And lHigh2 > lLow1: lHigh2 = lHigh2 - 1: Loop
If lLow2 < lHigh2 Then
For i = 1 To bytNum
sSwap = saArray(i, lLow2)
saArray(i, lLow2) = saArray(i, lHigh2)
saArray(i, lHigh2) = sSwap
Next i
End If
If lLow2 <= lHigh2 Then
lLow2 = lLow2 + 1
lHigh2 = lHigh2 - 1
End If
Loop
If lHigh2 > lLow1 Then QSLong2D saArray(), bytDim, lLow1, lHigh2, bytNum
If lLow2 < lHigh1 Then QSLong2D saArray(), bytDim, lLow2, lHigh1, bytNum
ErrorExit:
End Sub
Ниже приведен специальный алгоритм, который работает быстро, если ваши данные содержат целые числа. Он использует индексирование и логический тип данных.
Function IndexSort(ByRef myArray() As Long, bOrigIndex As Boolean) As Variant
'' Modified to take both positive and negative integers
Dim arrVals() As Long, arrSort() As Long, arrBool() As Boolean
Dim i As Long, HighB As Long, myMax As Long, myMin As Long, OffSet As Long
Dim LowB As Long, myIndex As Long, count As Long, myRange As Long
HighB = UBound(myArray)
LowB = LBound(myArray)
For i = LowB To HighB
If myArray(i) > myMax Then myMax = myArray(i)
If myArray(i) < myMin Then myMin = myArray(i)
Next i
OffSet = Abs(myMin) '' Number that will be added to every element
'' to guarantee every index is non-negative
If myMax > 0 Then
myRange = myMax + OffSet '' E.g. if myMax = 10 & myMin = -2, then myRange = 12
Else
myRange = OffSet
End If
If bOrigIndex Then
ReDim arrSort(1 To 2, 1 To HighB)
ReDim arrVals(1 To 2, 0 To myRange)
ReDim arrBool(0 To myRange)
For i = LowB To HighB
myIndex = myArray(i) + OffSet
arrBool(myIndex) = True
arrVals(1, myIndex) = myArray(i)
If arrVals(2, myIndex) = 0 Then arrVals(2, myIndex) = i
Next i
For i = 0 To myRange
If arrBool(i) Then
count = count + 1
arrSort(1, count) = arrVals(1, i)
arrSort(2, count) = arrVals(2, i)
End If
Next i
QSLong2D arrSort, 2, 1, count, 2
ReDim Preserve arrSort(1 To 2, 1 To count)
Else
ReDim arrSort(1 To HighB)
ReDim arrVals(0 To myRange)
ReDim arrBool(0 To myRange)
For i = LowB To HighB
myIndex = myArray(i) + OffSet
arrBool(myIndex) = True
arrVals(myIndex) = myArray(i)
Next i
For i = 0 To myRange
If arrBool(i) Then
count = count + 1
arrSort(count) = arrVals(i)
End If
Next i
ReDim Preserve arrSort(1 To count)
End If
ReDim arrVals(0)
ReDim arrBool(0)
IndexSort = arrSort
End Function
Вот функции Collection (от @DocBrown) и Dictionary (от @eksortso).
Function CollectionTest(ByRef arrIn() As Long, Lim As Long) As Variant
Dim arr As New Collection, a, i As Long, arrOut() As Variant, aFirstArray As Variant
Dim StrtTime As Double, EndTime1 As Double, EndTime2 As Double, count As Long
On Error Resume Next
ReDim arrOut(1 To UBound(arrIn))
ReDim aFirstArray(1 To UBound(arrIn))
StrtTime = Timer
For i = 1 To UBound(arrIn): aFirstArray(i) = CStr(arrIn(i)): Next i '' Convert to string
For Each a In aFirstArray ''' This part is actually creating the unique set
arr.Add a, a
Next
EndTime1 = Timer - StrtTime
StrtTime = Timer ''' This part is writing back to an array for return
For Each a In arr: count = count + 1: arrOut(count) = a: Next a
EndTime2 = Timer - StrtTime
CollectionTest = Array(arrOut, EndTime1, EndTime2)
End Function
Function DictionaryTest(ByRef myArray() As Long, Lim As Long) As Variant
Dim StrtTime As Double, Endtime As Double
Dim d As Scripting.Dictionary, i As Long '' Early Binding
Set d = New Scripting.Dictionary
For i = LBound(myArray) To UBound(myArray): d(myArray(i)) = 1: Next i
DictionaryTest = d.Keys()
End Function
Вот прямой подход, предоставленный @IsraelHoletz.
Function ArrayUnique(ByRef aArrayIn() As Long) As Variant
Dim aArrayOut() As Variant, bFlag As Boolean, vIn As Variant, vOut As Variant
Dim i As Long, j As Long, k As Long
ReDim aArrayOut(LBound(aArrayIn) To UBound(aArrayIn))
i = LBound(aArrayIn)
j = i
For Each vIn In aArrayIn
For k = j To i - 1
If vIn = aArrayOut(k) Then bFlag = True: Exit For
Next
If Not bFlag Then aArrayOut(i) = vIn: i = i + 1
bFlag = False
Next
If i <> UBound(aArrayIn) Then ReDim Preserve aArrayOut(LBound(aArrayIn) To i - 1)
ArrayUnique = aArrayOut
End Function
Function DirectTest(ByRef aArray() As Long, Lim As Long) As Variant
Dim aReturn() As Variant
Dim StrtTime As Long, Endtime As Long, i As Long
aReturn = ArrayUnique(aArray)
DirectTest = aReturn
End Function
Вот эталонная функция, которая сравнивает все функции. Следует отметить, что последние два случая обрабатываются немного по-разному из-за проблем с памятью. Также обратите внимание, что я не тестировал метод Collection
для Test Case Size = 10,000,000
. По какой-то причине он возвращал неверные результаты и вел себя необычно (я предполагаю, что у объекта коллекции есть ограничение на количество вещей, которые вы можете в него поместить. Я искал и не мог найти никакой литературы по этому вопросу).
Function UltimateTest(Lim As Long, bTestDirect As Boolean, bTestDictionary, bytCase As Byte) As Variant
Dim dictionTest, collectTest, sortingTest1, indexTest1, directT '' all variants
Dim arrTest() As Long, i As Long, bEquality As Boolean, SizeUnique As Long
Dim myArray() As Long, StrtTime As Double, EndTime1 As Variant
Dim EndTime2 As Double, EndTime3 As Variant, EndTime4 As Double
Dim EndTime5 As Double, EndTime6 As Double, sortingTest2, indexTest2
ReDim myArray(1 To Lim): Rnd (-2) '' If you want to test negative numbers,
'' insert this to the left of CLng(Int(Lim... : (-1) ^ (Int(2 * Rnd())) *
For i = LBound(myArray) To UBound(myArray): myArray(i) = CLng(Int(Lim * Rnd() + 1)): Next i
arrTest = myArray
If bytCase = 1 Then
If bTestDictionary Then
StrtTime = Timer: dictionTest = DictionaryTest(arrTest, Lim): EndTime1 = Timer - StrtTime
Else
EndTime1 = "Not Tested"
End If
arrTest = myArray
collectTest = CollectionTest(arrTest, Lim)
arrTest = myArray
StrtTime = Timer: sortingTest1 = SortingUniqueTest(arrTest, True): EndTime2 = Timer - StrtTime
SizeUnique = UBound(sortingTest1, 2)
If bTestDirect Then
arrTest = myArray: StrtTime = Timer: directT = DirectTest(arrTest, Lim): EndTime3 = Timer - StrtTime
Else
EndTime3 = "Not Tested"
End If
arrTest = myArray
StrtTime = Timer: indexTest1 = IndexSort(arrTest, True): EndTime4 = Timer - StrtTime
arrTest = myArray
StrtTime = Timer: sortingTest2 = SortingUniqueTest(arrTest, False): EndTime5 = Timer - StrtTime
arrTest = myArray
StrtTime = Timer: indexTest2 = IndexSort(arrTest, False): EndTime6 = Timer - StrtTime
bEquality = True
For i = LBound(sortingTest1, 2) To UBound(sortingTest1, 2)
If Not CLng(collectTest(0)(i)) = sortingTest1(1, i) Then
bEquality = False
Exit For
End If
Next i
For i = LBound(dictionTest) To UBound(dictionTest)
If Not dictionTest(i) = sortingTest1(1, i + 1) Then
bEquality = False
Exit For
End If
Next i
For i = LBound(dictionTest) To UBound(dictionTest)
If Not dictionTest(i) = indexTest1(1, i + 1) Then
bEquality = False
Exit For
End If
Next i
If bTestDirect Then
For i = LBound(dictionTest) To UBound(dictionTest)
If Not dictionTest(i) = directT(i + 1) Then
bEquality = False
Exit For
End If
Next i
End If
UltimateTest = Array(bEquality, EndTime1, EndTime2, EndTime3, EndTime4, _
EndTime5, EndTime6, collectTest(1), collectTest(2), SizeUnique)
ElseIf bytCase = 2 Then
arrTest = myArray
collectTest = CollectionTest(arrTest, Lim)
UltimateTest = Array(collectTest(1), collectTest(2))
ElseIf bytCase = 3 Then
arrTest = myArray
StrtTime = Timer: sortingTest1 = SortingUniqueTest(arrTest, True): EndTime2 = Timer - StrtTime
SizeUnique = UBound(sortingTest1, 2)
UltimateTest = Array(EndTime2, SizeUnique)
ElseIf bytCase = 4 Then
arrTest = myArray
StrtTime = Timer: indexTest1 = IndexSort(arrTest, True): EndTime4 = Timer - StrtTime
UltimateTest = EndTime4
ElseIf bytCase = 5 Then
arrTest = myArray
StrtTime = Timer: sortingTest2 = SortingUniqueTest(arrTest, False): EndTime5 = Timer - StrtTime
UltimateTest = EndTime5
ElseIf bytCase = 6 Then
arrTest = myArray
StrtTime = Timer: indexTest2 = IndexSort(arrTest, False): EndTime6 = Timer - StrtTime
UltimateTest = EndTime6
End If
End Function
И, наконец, вот саб, который производит таблицу выше.
Sub GetBenchmarks()
Dim myVar, i As Long, TestCases As Variant, j As Long, temp
TestCases = Array(1000, 5000, 10000, 20000, 50000, 100000, 200000, 500000, 1000000, 2000000, 5000000, 10000000)
For j = 0 To 11
If j < 6 Then
myVar = UltimateTest(CLng(TestCases(j)), True, True, 1)
ElseIf j < 10 Then
myVar = UltimateTest(CLng(TestCases(j)), False, True, 1)
ElseIf j < 11 Then
myVar = Array("Not Tested", "Not Tested", 0.1, "Not Tested", 0.1, 0.1, 0.1, 0, 0, 0)
temp = UltimateTest(CLng(TestCases(j)), False, False, 2)
myVar(7) = temp(0): myVar(8) = temp(1)
temp = UltimateTest(CLng(TestCases(j)), False, False, 3)
myVar(2) = temp(0): myVar(9) = temp(1)
myVar(4) = UltimateTest(CLng(TestCases(j)), False, False, 4)
myVar(5) = UltimateTest(CLng(TestCases(j)), False, False, 5)
myVar(6) = UltimateTest(CLng(TestCases(j)), False, False, 6)
Else
myVar = Array("Not Tested", "Not Tested", 0.1, "Not Tested", 0.1, 0.1, 0.1, "Not Tested", "Not Tested", 0)
temp = UltimateTest(CLng(TestCases(j)), False, False, 3)
myVar(2) = temp(0): myVar(9) = temp(1)
myVar(4) = UltimateTest(CLng(TestCases(j)), False, False, 4)
myVar(5) = UltimateTest(CLng(TestCases(j)), False, False, 5)
myVar(6) = UltimateTest(CLng(TestCases(j)), False, False, 6)
End If
Cells(4 + j, 6) = TestCases(j)
For i = 1 To 9: Cells(4 + j, 6 + i) = myVar(i - 1): Next i
Cells(4 + j, 17) = myVar(9)
Next j
End Sub
Резюме
Из таблицы результатов видно, что метод Dictionary
действительно хорошо работает для случаев менее 500 000, однако после этого IndexMethod
действительно начинает доминировать. Вы заметите, что когда порядок не имеет значения, а ваши данные состоят из натуральных чисел, нет никакого сравнения с алгоритмом IndexMethod
(он возвращает уникальные значения из массива, содержащего 10 миллионов элементов, менее чем за 1 секунду !!! Невероятно !). Ниже у меня есть разбивка, какой алгоритм предпочтителен в различных случаях.
Случай 1
Ваши данные содержат целые числа (т.е. целые числа, как положительные, так и отрицательные): IndexMethod
Дело 2
Ваши данные содержат нецелые числа (т.е. Вариант, двойное число, строку и т.д.), Содержащие менее 200 000 элементов: Dictionary Method
Дело 3
Ваши данные содержат нецелые числа (т.е. Вариант, двойное число, строку и т.д.) С более чем 200000 элементов: Collection Method
Если бы вам пришлось выбирать один алгоритм, по моему мнению, метод Collection
по-прежнему лучший, так как он требует всего несколько строк кода, он супер общий, и он достаточно быстрый.
Нет, ничего не встроено. Сделай сам:
Scripting.Dictionary
For
над вашим массивом (обязательно используйте LBound()
и UBound()
вместо цикла от 0 до x!)Exists()
в словаре. Добавьте каждое значение массива (которое еще не существует) в качестве ключа к словарю (CStr()
, поскольку ключи должны быть строкамиScripting.Dictionary
), также сохраните значение массива в словаре.Keys()
(или Items()
), чтобы вернуть все значения словаря в новый, теперь уникальный массив.Я не знаю каких-либо встроенных функций в VBA. Лучше всего было бы использовать коллекцию, используя значение как ключ, и только добавить к ней, если значение не существует.
Нет, у VBA нет этой функции. Вы можете использовать технику добавления каждого элемента в коллекцию, используя элемент в качестве ключа. Поскольку коллекция не позволяет дублировать ключи, результат представляет собой различные значения, которые вы можете скопировать в массив, если это необходимо.
Вам также может понадобиться нечто более надежное. См. Функцию "Значимые значения" в http://www.cpearson.com/excel/distinctvalues.aspx
Функция отличительных значений
Функция VBA, которая вернет массив различных значений в диапазон или массив входных значений.
Excel имеет некоторые ручные методы, такие как Расширенный фильтр, для получения списка отдельные элементы из диапазона ввода. Недостатком использования таких методов является что вы должны вручную обновить результаты при изменении входных данных. Более того, эти методы работают только с диапазоны, а не массивы значений, а не не могут быть вызваны из рабочих листов или формулы массива. На этой странице описывается Функция VBA называется DistinctValues который принимает в качестве входного значения диапазон или массив данных и возвращает его результатом будет массив, содержащий отдельные элементы из списка ввода. То есть, элементы со всеми дубликаты удалены. Порядок входные элементы сохранены. Приказ элементов в выходном массиве так же, как и порядок ввода значения. Функция может быть вызвана из диапазона ввода массива на лист (см. эту страницу для информация о формулах массива) или из формулы массива в одном рабочей линией, или из другого VB функция.
Решения для коллекции и словаря хороши и сияют для короткого подхода, но если вы хотите, чтобы скорость попыталась использовать более прямой подход:
Function ArrayUnique(ByVal aArrayIn As Variant) As Variant
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ArrayUnique
' This function removes duplicated values from a single dimension array
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim aArrayOut() As Variant
Dim bFlag As Boolean
Dim vIn As Variant
Dim vOut As Variant
Dim i%, j%, k%
ReDim aArrayOut(LBound(aArrayIn) To UBound(aArrayIn))
i = LBound(aArrayIn)
j = i
For Each vIn In aArrayIn
For k = j To i - 1
If vIn = aArrayOut(k) Then bFlag = True: Exit For
Next
If Not bFlag Then aArrayOut(i) = vIn: i = i + 1
bFlag = False
Next
If i <> UBound(aArrayIn) Then ReDim Preserve aArrayOut(LBound(aArrayIn) To i - 1)
ArrayUnique = aArrayOut
End Function
Вызов:
Sub Test()
Dim aReturn As Variant
Dim aArray As Variant
aArray = Array(1, 2, 3, 1, 2, 3, "Test", "Test")
aReturn = ArrayUnique(aArray)
End Sub
Для сравнения скорости это будет от 100x до 130x быстрее, чем решение словаря, и примерно от 8000x до 13000x быстрее, чем коллекция.
Если порядок дедуплицированного массива для вас не имеет значения, вы можете использовать мою прагматическую функцию:
Function DeDupArray(ia() As String)
Dim newa() As String
ReDim newa(999)
ni = -1
For n = LBound(ia) To UBound(ia)
dup = False
If n <= UBound(ia) Then
For k = n + 1 To UBound(ia)
If ia(k) = ia(n) Then dup = True
Next k
If dup = False And Trim(ia(n)) <> "" Then
ni = ni + 1
newa(ni) = ia(n)
End If
End If
Next n
If ni > -1 Then
ReDim Preserve newa(ni)
Else
ReDim Preserve newa(1)
End If
DeDupArray = newa
End Function
Sub testdedup()
Dim m(5) As String
Dim m2() As String
m(0) = "Horse"
m(1) = "Cow"
m(2) = "Dear"
m(3) = "Horse"
m(4) = "Joke"
m(5) = "Cow"
m2 = DeDupArray(m)
t = ""
For n = LBound(m2) To UBound(m2)
t = t & n & "=" & m2(n) & " "
Next n
MsgBox t
End Sub
Из тестовой функции это приведет к следующему дедуплицированному массиву:
"0 = Дорогой 1 = Лошадь 2 = Шутка 3 = Корова"
В VBA нет встроенной функциональности для удаления дубликатов из массива, однако вы можете использовать следующую функцию:
Function RemoveDuplicates(MyArray As Variant) As Variant
With CreateObject("scripting.dictionary")
For Each item In MyArray
c00 = .Item(item)
Next
sn = .keys ' the array .keys contains all unique keys
MsgBox Join(.keys, vbLf) ' you can join the array into a string
RemoveDuplicates = .keys ' return an array without duplicates
End With
End Function
Я очень новичок в VBA. Однако, когда я искал точно такое же решение, мне нужен был способ прокрутки без необходимости указывать в другом массиве ключевые элементы. Поэтому я написал следующий код, он работает, и он короткий. Надеюсь, это поможет!
title - это 1-мерный массив в моем коде
For i = UBound(titles) To LBound(titles) + 1 Step -1 'Looping backwards through the array
If titles(i) = titles(i - 1) Then 'If the last element is the same as the one before it
ReDim Preserve titles(i - 1) 'Then trim it down by one. Essentially, delete it from the array
End If
Next i