엑셀 VBA #90 / 데이터재배치 [VBA]

Sub vba90강231231()

Dim rng As Range, c As Range
Dim nc As New Collection
Dim j As Long, i As Long, k As Long
Dim a()

' C열 데이타를 텍스트 타입으로 바꾸기
Set rng = Range("c5", Cells(Rows.Count, "c").End(3))
rng.TextToColumns Destination:=rng, fieldinfo:=Array(1, 2)


'정렬하기
Range("b5", Cells(Rows.Count, "c").End(3)).Sort Range("b5", Cells(Rows.Count, "c").End(3))(1, 2)

'New Collection & 배열 접목
On Error Resume Next
For Each c In rng
      nc.Add Trim(c), CStr(Trim(c))
Next
On Error GoTo 0

j = 1   'j의 초기값을 설정하지않으면 0부터 시작함..nc의 초기값은 1이므로 본 코드 필요
i = 5
Range("e4").Select

Do
      Do While Cells(i, "c") = nc(j)
            ReDim Preserve a(k)
            a(k) = nc(j) 'nc(j)의 값을 동적배열 a변수에 집어 넣기
            ActiveCell.Offset(1) = k + 1
            ActiveCell.Offset(1, 1) = nc(j)
            ActiveCell.Offset(1).Select
            k = k + 1
            i = i + 1
      Loop
            j = j + 1
            k = 0
            Erase a
            ActiveCell.Offset(1).Select
Loop While j <= nc.Count


End Sub

https://www.youtube.com/watch?v=x9b1bRVoMic&t=736s

ㅁㅁㅁ

엑셀 VBA #118 / Dictionary 개체_기본 [VBA]

[New Dictionary]
Dim dict As Oject
Set dict = CreateObject("scripting.dictionary")
위 두 문장으로 된 구문( Late Binding이라 함)을

아래 하나의 문장으로 된 구문( Early Binding이라 함)으로 할 수 있다.

Dim dict As New Scripting.Dictionary



1.구조 
Dictionary이름명. Add  Key  Item


2. 예시
dict.Add "사과",111
dict.Add "바나나",222
dict.Add "딸기",333

3. For ~ Next문에 적용

3.1. 기본
Dim dict As New Scripting.Dictionary
Dim i As Long

dict.Add "사과", 111
dict.Add "바나나", 222
dict.Add "딸기", 333

For i = 0 To 2
    Cells(i + 1, 1) = dict.Items(i)
Next

위 구문의 문제점은 Item 갯수가 아주 많은 경우에는 처리속도가 느려진다는 것이다..

그래서 Key  및 Item값을 워크시트에 한꺼번 뿌려줄 필요가 있다.

이것을 할 수 있는 방법이 '배열'이다.

3.1. 동적배열

Dim dict As New Scripting.Dictionary
Dim i As Long
Dim arr() As Variant    '동적배열 적용. arr()의 값 유형을 모르니 Variant로 한다.

dict.Add "사과", 111
dict.Add "바나나", 222
dict.Add "딸기", 333

For i = 0 To 2
    'Cells(i + 1, 1) = dict.Items(i)
    ReDim Preserve arr(i)   ' 동적배열 적용문으로 동적배열의 사이즈를 i값으로 재선언
    arr(i) = dict.Items(i)        'item(i)값을 arr방에 집어넣기!!!!
Next

이제는 arr방에 들어온 item(i)값을 시트에 뿌려보자

......

   arr(i) = dict.Items(i)
Next

range("A1:A3") =arr

메모리 상에서는 arr은 아래 그림처럼 가로로 담겨져 있다.

이를 A1:A3로 올바르게 뿌려지기 위해서는 Transpose함수를 아래처럼 적용해야 한다.

range("A1:A3") =Application.transpose(arr)

3.1.1. UBound & LBound

For~Next문에서 i의 마지막 값을 프로그램이 자동으로 지정할 수 있도록 해야한다. 하드코딩하는 방법을 바람직하지 않다.프로그램이 알아서 값을 지정할 수 있도록 하는 변수에는 UBound와 LBound가 있다.

For i = 0 To 2

For i = 0 To UBound(dict.Items)   

4. 최종 코드

Sub Pdictionary()

Dim dict As New Scripting.Dictionary
Dim i As Long
Dim arr() As Variant

dict.Add "사과", 111
dict.Add "바나나", 222
dict.Add "딸기", 333

For i = 0 To UBound(dict.Items)
    'Cells(i + 1, 1) = dict.Items(i)
    ReDim Preserve arr(i)
    arr(i) = dict.Items(i)
Next

Range("A1:A3") = Application.Transpose(arr)
 
End Sub

VBA - Dictionary(Late vs Early Binding) by 우노사설

https://www.youtube.com/watch?v=1yBE6MGkIA4&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=120

엑셀 VBA #65 / 질문 답변(데이터 취합) [VBA]

[하나의 통합문서에 있는 여러 시트들의 데이터들을
중복데이터 제거 후 '통합'시트에 하나로 취합하는 방법]

해결 방법
1. 엑셀 기능(RemoveDuplicates) 적용한 VBA코딩
2. New Collection활용 한 VBA코딩

1. 엑셀 기능(RemoveDuplicates) 적용한 VBA코딩

Sub 통합생성_고유항목만_1()

Dim shAll As Worksheet
Dim sh As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False  '기존 통합시트 삭제시 '삭제하시겠습니까?'라는 메세지창 나오기 않게!
On Error Resume Next   '만약 기존 통합시트가 없는 경우에, 아래 코드 실행시 에레 발생하므로

                                         본 코드삽입하여 에레발생하면 그냥 넘어가라는 의미
    Sheets("통합").Delete
On Error GoTo 0

Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "통합"
Set shAll = Sheets("통합")

For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> ActiveSheet.Name Then '만약 시트 이름이 activesheet(현재활성화된 시트=통합)이름과 다르다면
        sh.Range("A1").CurrentRegion.Copy shAll.Cells(Rows.Count, "a").End(xlUp).Offset(1)
    End If
Next

shAll.Range("A2").CurrentRegion.RemoveDuplicates (Array(1, 2))

shAll.Rows(1).Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

2. New Collection활용 한 VBA코딩

Sub 통합생성_고유항목만_2()

Dim shAll As Worksheet
Dim sh As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False 
On Error Resume Next 
    Sheets("통합").Delete
On Error GoTo 0

Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "통합"
Set shAll = Sheets("통합")

For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> ActiveSheet.Name Then
        sh.Range("A1").CurrentRegion.Copy shAll.Cells(Rows.Count, "a").End(xlUp).Offset(1)
    End If
Next

'----------------------------------------
'New Collection
'----------------------------------------
Dim rng As Range, c As Range
Dim pc As New Collection
Dim e As Variant
Dim i

Set rng = shAll.Range("A2", shAll.Cells(Rows.Count, "A").End(xlUp))

On Error Resume Next
For Each c In rng
    If Len(c) Then
        pc.Add Trim(c), CStr(Trim(c))
    End If
Next
On Error GoTo 0

For Each e In pc
    i = i + 1
    shAll.Cells(i, "d") = e
    shAll.Cells(i, "e") = rng.Find(e, , , xlWhole).Offset(, 1).Value
Next
shAll.Columns("a:c").Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

https://www.youtube.com/watch?v=Tp7qn6n_wVM&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=65

ㅁㅁㅁ

엑셀 VBA #52 / 중복데이터 처리_5 [VBA]-고유항목별 합계구하기

Sub 중복데이터_시군구별합계()

Dim gu As New Collection
Dim rgu As Range, c As Range
Dim e As Variant
Dim tot As Long

Application.ScreenUpdating = False

Set rgu = Range("F2", Cells(Rows.Count, "F").End(xlUp))

'고유한 시군구 추출
On Error Resume Next
For Each c In rgu
    If Len(c) Then
        gu.Add Trim(c), CStr(Trim(c))
    End If
Next
On Error GoTo 0

'시군구별로 합계 ->시군구별 시트 생성->생성된 시트에 합계를 뿌리기
For Each e In gu        'e=new collection(gu)에 저장된 고유한 목록 하나하나..!
    tot = Application.SumIf(rgu, e, rgu.Offset(, 2))
    'sumif(조건범위, 조건,합을 구할 범위)
    '합을 구할 범위 'H2:H열 마지막행'인데 이를 'rgu.Offset(, 2)'로 하는게 Good!!!!
    Worksheets.Add(after:=Sheets(Sheets.Count)).Name = e  '시군구별 시트 생성
    With Sheets(e)
        .Range("A1").Resize(1, 2) = Array("시군구", "통화건수")
        .Range("A2") = e
        .Range("B2") = tot
    End With
Next
Application.ScreenUpdating = True

End Sub

https://www.youtube.com/watch?v=dHBovWeJbw8&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=52

엑셀 VBA #49 / New Collection_버블정렬의 콜라보 [VBA]

Dim nc As New Collection
Dim rng As Range, c As Range
Dim a() As Variant
Dim i As Long

Set rng = Range("A1", Cells(Rows.Count, "A").End(xlUp))

'----------------------------
'고유목록 추출
'----------------------------
On Error Resume Next
For Each c In rng
    If Len(c) Then
        nc.Add Trim(c), CStr(Trim(c))
    End If
Next
On Error GoTo 0

'---------------------------
'배열에 넣기(dc에서 저장하고 있는 고유목록을 동적배열a에 넣기)
'---------------------------
ReDim a(nc.Count - 1)

For i = 0 To nc.Count - 1
    a(i) = nc(i + 1)
Next

'---------------------------
'동적배열a에 있는 값을 뿌리기
'---------------------------
Range("C1").Resize(1, UBound(a) + 1) = a
Range("B1").Resize(UBound(a) + 1, 1) = Application.Transpose(a)

위 결과값 그림상의 고유항목들이 오름 or 내림차순 정렬이 아니다.
이를 오름차순 정렬한 코드는 다음과 같다.
Dim nc As New Collection
Dim rng As Range, c As Range
Dim a() As Variant
Dim i As Long, j As Long
Dim temp As Variant

.................
'---------------------------
'배열에 넣기(dc에서 저장하고 있는 고유목록을 동적배열a에 넣기)
'---------------------------
ReDim a(nc.Count - 1)
For i = 0 To nc.Count - 1
    a(i) = nc(i + 1)
Next

'---------------------------
'정렬(버블정렬)
'---------------------------
For i = 0 To dc.Count - 2
    For j = i + 1 To dc.Count - 1
        If a(i) > a(j) Then
            temp = a(i)
            a(i) = a(j)
            a(j) = temp
        End If
    Next
Next
'---------------------------
'동적배열a에 있는 값을 뿌리기
'---------------------------
Range("C1").Resize(1, UBound(a) + 1) = a
Range("B1").Resize(UBound(a) + 1, 1) = Application.Transpose(a)

https://www.youtube.com/watch?v=uuyRUNZC2GE&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=49

엑셀 VBA #47 / 중복데이터 처리_1 [VBA]

중복데이터 처리 방법
1. Removeduplicates

    영역.RemoveDuplicates 중복제거할 열표시, Header포함여부

    cf, 중복제거 기준 열이 2이상 일 경우??????

     영역. RemoveDuplicates (array(1,2,...)), Header포함여부
2. 고급필터
3. New Collection


1. Removeduplicaste
Sub 중복데이터_removeduplicate()

Dim rng As Range
Set rng = Range("A1", Cells(Rows.Count, "A").End(xlUp))

rng.Copy Range("D1")
Range("D1").CurrentRegion.RemoveDuplicates 1, xlYes     '영역에서 첫번째 열 기준을 중복제거

End Sub

2. 고급필터
Sub 중복데이터_고급필터()
Dim rng As Range
Set rng = Range("A1", Cells(Rows.Count, "A").End(xlUp))

rng.AdvancedFilter xlFilterInPlace, , , 1

'xlFilterInPlace : '현재 위치 필터' 적용 의미
rng.SpecialCells(xlCellTypeVisible).Copy Range("D1")
ActiveSheet.ShowAllData

End Sub

3. New Collection
Sub 중복데이터_New_Collection()

Dim rng As Range

Dim c As Range
Dim dc As New Collection  '고유목록만 모여질 변수로 받음
Dim i As Long

Set rng = Range("A1", Cells(Rows.Count, "A").End(xlUp))

'------------------------------------------------------
'고유목만 dc변수방에 모우기
'------------------------------------------------------
On Error Resume Next

For Each c In rng
    If Len(c) Then '만약 변수c에 값이 있으면  ' 'If Not nc Is Nothing Then'으로 해도 결과동일하네... 
        dc.Add Trim(c), CStr(Trim(c))
    End If
Next

'------------------------------------------------------
'고유목을 뿌리기
'------------------------------------------------------
For i = 1 To dc.Count
    Cells(i, "D") = dc(i)
Next

End Sub

https://www.youtube.com/watch?v=Zr2pd5ZMfDQ&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=47

엑셀 VBA #35 / 고급필터 [VBA]
VBA - 중복값 제거(New Collection)
엑셀 VBA #65 / 질문 답변(데이터 취합) [VBA]    RemoveDuplicates (Array(1,2)

엑셀 VBA #26 / For Each~Next_2 [VBA] - New Collection

On Error Resume Next
For Each c In rng
      dc.Add Trim(c), CStr(Trim(c))
Next
On Error GoTo 0

For i = 1 To dc.Count
      Cells(i + 11, "A") = dc(i)
      Cells(i + 11, "B") = Application.SumIf(rc, dc(i), rs)

Sub For_Each_Next_and_New_Collection_고유값합계()

Dim dc As New Collection
Dim rng As Range
Dim c As Range
Dim i As Long
Dim rc As Range, rs As Range

Set rng = Range("A2:A" & Range("A2").CurrentRegion.Rows.Count)
'=Set rng = Range("A2", Cells(Rows.Count, "A").End(xlUp))


On Error Resume Next
For Each c In rng
      dc.Add Trim(c), CStr(Trim(c))
Next
On Error GoTo 0

Range("A11") = "고유목록별 합계"

Set rc = Range("A2:A9")
Set rs = Range("B2:B9")

For i = 1 To dc.Count
      Cells(i + 11, "A") = dc(i)
      Cells(i + 11, "B") = Application.SumIf(rc, dc(i), rs)
      
Next
End Sub

핵심정리

On Error Resume Next
For Each c In rng
      dc.Add Trim(c), CStr(Trim(c))
Next
On Error GoTo 0

https://www.youtube.com/watch?v=BC_O6sVx4SA&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=26

How to use VBA Collections in Excel