vba: 어레이에서 원하는 값 가져오기
vba에는 1차원 어레이에서 고유한 값을 가져오는 기능이 내장되어 있습니까?그냥 복제품을 없애는 건 어때?
그렇지 않은 경우 어레이에서 원하는 값을 얻으려면 어떻게 해야 합니까?
이 투고에는 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
On Error Goto 0 ' added to original example by PEH
For i = 1 To arr.Count
Cells(i, 1) = arr(i)
Next
End Sub
어레이에서 중복을 제거하는 기능은 내장되어 있지 않습니다.라지의 대답은 우아해 보이지만, 나는 사전을 사용하는 것을 선호한다.
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: edit프변변변 edit edit edit edit edit edit edit이다를 하도록 했습니다.LBound ★★★★★★★★★★★★★★★★★」UBound편집 ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★:d.Keys()【변종】【수집】【수집】【수집】
갱신(6/15/16)
나는 훨씬 더 철저한 벤치마크를 만들었다.우선 @ChaimG가 지적한 바와 같이 초기 바인딩은 큰 차이를 가져옵니다(원래는 레이트바인딩을 사용하는 말 그대로 @eksortso의 코드를 사용했습니다).둘째, 원래 벤치마크에는 고유한 개체를 만드는 시간만 포함되었지만 개체 사용의 효율성을 테스트하지 않았습니다.이 작업의 요점은, 내가 만든 물체가 투박해서 앞으로 나아가는 속도가 느려진다면, 내가 정말 빨리 만들 수 있는지는 별로 중요하지 않다는 것입니다.
오래된 비고:수집 오브젝트를 루핑하는 것은 매우 비효율적이라는 것이 판명되었습니다.
수집을 루핑하는 방법을 알고 있다면 매우 효율적일 수 있습니다(저는 그렇게 하지 않았습니다).에서 지적했듯이 @ChaimG 한 번@ChaimG를 For Each하게 사용하는 For에 시간을 .Collection2★★★★★★★★★★★★★★★★의 경우Test Case Size = 10^61400달러(23달러)0.7000초
님의 Collection이치노번째 ( 벤치마크)Collection1)는 오브젝트를 있습니다). 부분예: the the the. the. the. the. the. the.Collection2로 반환 는 다른 함수와 마찬가지로 반환 가능한 배열을 작성하기 위해 오브젝트(매우 자연스러운)를 루프하는 시간을 나타냅니다.
다음 그래프에서 노란색 배경은 해당 테스트 케이스에서 가장 빨랐음을 나타내고 빨간색은 가장 느림을 나타냅니다("테스트되지 않음" 알고리즘은 제외됩니다).의 Collection는 method의 입니다.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
다음은 컬렉션(@DocBrown)과 사전(@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알고리즘(1초 이내에 1000만 요소를 포함하는 배열에서 원하는 값을 반환합니다!!!는 다양한 경우에 알고리즘이입니다.아래는 다양한 경우에 어떤 알고리즘이 선호되는지에 대한 분류입니다.
1 ★★★★★★★
데이터에 정수(양수 및 음수 모두 정수)가 포함되어 있습니다. IndexMethod
2
,000개 요소를 정수 의 값 스트링 .즉,,000개 미만입니다.Dictionary Method
3의 경우 3)
,000개 의 요소를 정수 의 요소.이러한 요소는 200,000개 이상입니다.Collection Method
해야 한다면, 때 '을 선택해주세요', '알고리즘을 선택해주세요 '알고리즘', '알고리즘',Collection몇 줄의 코드만 있으면 되고, 매우 일반적이며, 충분히 빠르기 때문에 방법은 여전히 최고입니다.
365년 시점에서는 그렇습니다.UNIQURE를 사용할 수 있지만 입력이 RANGE가 아닌 한 먼저 TRANSPOSE를 사용해야 합니다.그리고 재미로 SORT.
Option Explicit
Sub testIt()
Dim arr() As Variant
arr = [{1,2,3,4,1,2}]
uniquify arr
arr = Array( _
"Banana", "Apple", "Orange", "Tomato", "Apple", _
"Lemon", "Lime", "Lime", "Apple" _
)
uniquify arr
arr = [{"a", "b", "a", "c", "a", "b", "a"}]
uniquify arr
End Sub
Sub uniquify(arr As Variant)
Dim buffer() As Variant, b As Variant
buffer = WorksheetFunction.Sort( _
WorksheetFunction.Unique( _
WorksheetFunction.Transpose(arr) _
) _
)
For Each b In buffer
Debug.Print b
Next
End Sub
VBA에 내장된 기능은 모릅니다.가장 좋은 방법은 값을 키로 사용하여 컬렉션을 사용하고 값이 존재하지 않는 경우에만 추가하는 것입니다.
아니요, 기본 제공은 없습니다.직접 실행:
- 「」의
Scripting.Dictionary표시 - 를 쓰다
For하세요)LBound()★★★★★★★★★★★★★★★★★」UBound()에서 x로 루프하는 ) 0으로 루프합니다.(XXXXXX) - 반복할 마다 체크해 .
Exists()사전에 수록되어 있습니다.사전에 키로서 모든 어레이 값(아직 존재하지 않는 값)을 추가합니다.사용하다CStr()키는 문자열이어야 하므로Scripting.Dictionary값 는 배열 값 자체를 사전에 저장합니다. - 「」를 합니다.
Keys()(오류)Items()사전의 모든 값을 새로운 고유 배열로 되돌립니다. - 이 테스트에서는 사전이 모든 추가 값의 원래 순서를 유지하므로 출력은 이전과 같이 정렬됩니다.하지만 이것이 문서화되어 있고 신뢰할 수 있는 행동인지는 잘 모르겠습니다.
stdVBA(대부분 스스로 관리하는 라이브러리)를 사용하면 다음을 사용할 수 있습니다.
uniqueValues = stdEnumerator.CreateFromArray(myArray).Unique().AsArray()
주의:
,도 수 ,UniqueCollectionIEnumVARIANT:
uniqueValues = stdEnumerator.CreateFromIEnumVARIANT(myCollection).Unique().AsCollection()
,도 수 ,Unique'이것'은 다음과 같습니다.
uniqueValues = stdEnumerator.CreateFromIEnumVARIANT(ThisWorkbook.Sheets).Unique(stdLambda("$1.range(""A1"").value")).AsCollection()
아니요, VBA에는 이 기능이 없습니다.항목을 키로 사용하여 컬렉션에 각 항목을 추가하는 기술을 사용할 수 있습니다.수집에서는 중복 키를 허용하지 않으므로 필요한 경우 어레이에 복사할 수 있는 고유한 값이 생성됩니다.
또, 보다 견고한 것을 원하실 수도 있습니다.http://www.cpearson.com/excel/distinctvalues.aspx에서 "Different Values Function"을 참조하십시오.
고유 값 함수
범위 내 고유값 배열 또는 입력값 배열을 반환하는 VBA 함수입니다.
Excel에는 입력 범위로부터 구별되는 항목의 리스트를 취득하기 위한 Advanced Filter 등의 수동 메서드가 있습니다.이러한 방법을 사용할 경우 입력 데이터가 변경될 때 결과를 수동으로 새로 고쳐야 하는 단점이 있습니다.또한 이러한 메서드는 값의 배열이 아닌 범위에서만 작동하며, 함수가 아닌 워크시트 셀에서 호출하거나 배열 공식에 통합할 수 없습니다.이 페이지에서는 범위 또는 데이터 배열 중 하나를 입력으로 받아들이고 그 결과 입력 목록에서 고유한 항목을 포함하는 배열을 반환하는 Distinct Values라는 VBA 함수에 대해 설명합니다.즉, 모든 중복 요소가 제거된 것입니다.입력 요소의 순서는 유지됩니다.출력 배열의 요소 순서는 입력 값의 순서와 동일합니다.이 함수는 워크시트에 입력된 배열 범위(배열 공식에 대한 자세한 내용은 이 페이지를 참조하십시오) 또는 단일 워크시트 셀의 배열 공식 또는 다른 VB 함수에서 호출할 수 있습니다.
Collection 및 Dictionary 솔루션은 간단한 접근법으로는 모두 훌륭하지만, 보다 직접적인 접근법으로 속도를 높이려면 다음과 같이 하십시오.
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
속도 비교는 사전 솔루션보다 100배에서 130배, 컬렉션 솔루션보다 약 8000배에서 13000배 더 빠릅니다.
어레이에서 중복을 제거하기 위한 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
중복 배제된 어레이의 순서가 문제가 되지 않는 경우는, 다음의 실용적인 기능을 사용할 수 있습니다.
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=목마"
언급URL : https://stackoverflow.com/questions/3017852/vba-get-unique-values-from-array
'programing' 카테고리의 다른 글
| SQL Server에서 구체화된 뷰를 작성하는 방법 (0) | 2023.04.19 |
|---|---|
| 의 의미.셀(.Rows).카운트 "A").End(xlUp).행 (0) | 2023.04.19 |
| Swift에서 문자열을 배열로 분할하시겠습니까? (0) | 2023.04.14 |
| Excel VBA 프로젝트에서 암호를 해독하는 방법이 있습니까? (0) | 2023.04.14 |
| 인쇄 탭에서 '모든 열을 한 페이지에 맞춤'을 설정하는 방법 (0) | 2023.04.14 |