|
제 YouTube를 소개합니다.
'=====================================================
Excel,VBA,Google SpreadSheet 등 다양한 자료가 있습니다.
=====================================================
https://www.youtube.com/channel/UChR2YTnlpU9OVfLyH_09YeA
'------------------------
소스코드
'------------------------
'------------------------
Sub separate_data()
'------------------------
Dim rngX As Range: Set rngX = Range("A1").CurrentRegion
Dim shtX As Worksheet: Set shtX = ActiveSheet
If shtX.AutoFilterMode Then shtX.AutoFilterMode = False
Dim varX As Variant: varX = get_unique_1
Dim v As Variant
'Stop
Dim sht As Worksheet
Application.ScreenUpdating = False
' Sheet 삭제
Application.DisplayAlerts = False
For Each sht In Worksheets
If sht.Name <> "합계" Then sht.Delete
Next sht
Application.DisplayAlerts = True
For Each v In varX
rngX.AutoFilter 2, v
Set sht = Worksheets.Add(after:=Worksheets(Worksheets.Count))
sht.Name = v
rngX.Copy sht.Range("A1")
Next v
shtX.Activate
shtX.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub
'-------------------------
Function get_unique_1() As Variant
'-------------------------
Dim varX As Variant: varX = Range("A1").CurrentRegion.Value
Dim oList As Object: Set oList = CreateObject("System.Collections.ArrayList")
Dim r As Long, v As Variant
For r = 2 To UBound(varX, 1)
If Not oList.contains(varX(r, 2)) Then
oList.Add varX(r, 2)
End If
Next r
oList.Sort
get_unique_1 = oList.toArray
End Function |
|