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

VBA

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

어린왕자1234 2021. 11. 17. 14:10

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

저작자표시 (새창열림)