|
'제 YouTube를 소개합니다.
'=======================================
'Excel,VBA관련 다양한 자료가 있습니다.
'=======================================
'https://www.youtube.com/channel/UChR2YTnlpU9OVfLyH_09YeA
'------------------------------------------------------
'--------------------------------------------------
Sub get_unique()
'--------------------------------------------------
Dim varX As Variant: varX = Range("A1").CurrentRegion.Value
Dim sKey As String: sKey = ""
Dim vResult As Variant: vResult = Array()
Dim r As Long
'------------------------------
For r = 2 To UBound(varX, 1)
'------------------------------
If sKey = "" Then
push vResult, Array(varX(r, 2), varX(r, 3), varX(r, 4))
sKey = varX(r, 2) & ":" & varX(r, 4)
Else
If sKey <> varX(r, 2) & ":" & varX(r, 4) Then
push vResult, Array(varX(r, 2), varX(r, 3), varX(r, 4))
sKey = varX(r, 2) & ":" & varX(r, 4)
End If
End If
Next r
vResult = WorksheetFunction.Transpose(WorksheetFunction.Transpose(vResult))
With Range("A20")
.CurrentRegion.ClearContents
.Resize(UBound(vResult, 1), UBound(vResult, 2)).Value = vResult
End With
End Sub
'------------------------------------
Sub push(arr As Variant, ele As Variant)
'------------------------------------
Dim i As Long: i = UBound(arr) + 1
ReDim Preserve arr(i)
arr(i) = ele
End Sub |
|