Excel VBA for Uniques

Question

오른쪽에서 주어진 형식으로 고유를 추출하려고합니다. 포럼 사이트 중 하나에서 VBA 코드를 발견했지만이 코드는 저에게 적합하지 않습니다. 코드를 수정하거나 더 좋은 것을 쓸 수있는 방법이 있습니까? 수식이 있지만 수식은 리소스 집약적이며 매우 큰 Excel로드는 매우 느립니다.

Sub FindDistinctValues() 
Dim LastRowFrom As Long 
Dim LastRowTo As Long 
Dim i As Long, j As Long 
Dim temp As Integer 
Dim found As Boolean 
'determines the last row that contains data in column A 
LastRowFrom = Range("A" & Rows.Count).End(xlUp).Row 
'Loop for each entry in column A 
For i = 2 To LastRowFrom 
'get the next value from column A 
temp = Range("A" & i).Value 

'Determine the last row with data in column B 
LastRowTo = Range("B" & Rows.Count).End(xlUp).Row 

'initialize j and found 
j = 1 
found = False 

    'Loop through "To List" until a match is found or the list has been searched 
     Do 
     'check if the value exists in B column 
     If temp = Range("B" & j).Value Then 
    found = True 
    End If 
    'increment j 
    j = j + 1 
    Loop Until found Or j = LastRowTo + 1 

    'if the value is not already in column B 
    If Not found Then 
    Range("B" & j).Value = temp 
    End If 
Next i 
End Sub 

http://image.prntscr.com/image/6bea7bb438ef4678a50cec6bebc78589.png

Answer 1

나는 그것을 테스트하지 않았지만이 같은 : 내가 그렇게하는 대신 코드 때문에 노력의 엉망이있어, 여기에 게시 이미지가 게시되지 않은 참조

Sub FindDistinctValues() 
    Dim dict As Object, cell As Range 
    Set dict = CreateObject("Scripting.Dictionary") 

    For Each cell in Range("A1").CurrentRegion.Resize(, 1) 
     If Not dict.Exists(cell & "") 
      cell(, 2) = "Unique" 
      dict.Add cell & "", 0 
     End If 
    Next 
End Sub