[Excel][VBA] 중복데이터 추출

Switch 알고리즘을 이용한 중복데이터 추출

CODE

Function Switch_Algorism(arr)     ' 중복데이터 제거 -> 단일 데이터          Dim i, j, k, cnt As Integer     Dim NewArray() As Variant     k = 0     For i = LBound(arr) To UBound(arr) - 1         cnt = 0         For j = i + 1 To UBound(arr)             If arr(i) = arr(j) Then                 cnt = cnt + 1                 Exit For             End If         Next j         If cnt = 0 Then             ReDim Preserve NewArray(k)             NewArray(k) = arr(i)             Debug.Print NewArray(k)             k = k + 1                      End If     Next i     ReDim Preserve NewArray(k)     NewArray(k) = arr(UBound(arr))          Switch_Algorism = NewArray     Debug.Print NewArray(k)    End Function

Sub test1()     Dim Arr1, Arr2 As Variant     Dim i As Integer     Arr1 = Array(1, 2, 3, 8, 1, 3, 5, 1, 6, 7, 9, 6, 2, 4, 1, 2)     Arr2 = Switch_Algorism(Arr1)     Debug.Print ("[result]")     For i = 0 To UBound(Arr2)         Debug.Print (Arr2(i))     Next i          End Sub

 

 

 

■ 중복추출 함수를 호출하여 List 시트에 부서명 리스트 추출

CODE

Sub Test()     Dim rng As Range     Dim arr(), NewArr, r, j As Variant     Dim i, k As Integer     Dim a As String          Set rng = ActiveWorkbook.Worksheets("Sheet1").Range("b5:b16")     i = 0     For Each r In rng         ReDim preserve arr(i)         arr(i) = r         i = i + 1              Next r               NewArr = Switch_Algorism(arr)          Worksheets.Add after:=Worksheets("Sheet1")     ActiveSheet.Name = "LIST"          ActiveSheet.Range("a3") = "부서명"              For k = 0 To UBound(NewArr)         ActiveSheet.Range("a3").Offset(k + 1, 0) = NewArr(k)     Next k     End Sub

중복추출.xlsm

0.02MB