엑셀 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 #88 / 시트통합_VBA필수 [VBA]

Sub MergeData_By_For_Next()
      Dim i As Long
      
      Application.ScreenUpdating = False
      
      Sheet1.Cells.Clear
      
      For i = 2 To 4
      'sheet2번부터 4번까지(1월~3월시트)//// 4를 'Worksheets.Count'로 하는 게 High Class
            Sheets(i).Range("a1").CurrentRegion.Copy _
            Sheet1.Cells(Rows.Count, "a").End(xlUp).Offset(1)
            '~~~~~~End(xlUp).Offset(1) => ~~~~~End(3)(2)
      Next
      
      Application.ScreenUpdating = True
End Sub

Sub MergeData_By_For_Each_Next()

      Dim sh As Worksheet
      Dim i As Long
      
      Application.ScreenUpdating = False
      
      Sheet1.Cells.Clear
      
      i = 2
      For Each sh In ThisWorkbook.Worksheets
            'if sh.name<>activesheet.name then
            If sh.Name <> Sheet1.Name Then   
            'If sh<>Sheet1 Then하면 에러인데...왜?
                  Sheets(i).Range("a1").CurrentRegion.Copy _
                  Sheet1.Cells(Rows.Count, "a").End(xlUp).Offset(1)
                  i = i + 1
            End If
      Next

      Application.ScreenUpdating = True
      
End Sub

Sub MergeData_By_Do_Loop()

      Dim cnt As Long, i As Long
      
      Application.ScreenUpdating = False
      
      Sheet1.Cells.Clear
      
      cnt = Worksheets.Count
      
      i = 2
      
      Do While i <= cnt
        Sheets(i).Range("a1").CurrentRegion.Copy _
        Sheet1.Cells(Rows.Count, "a").End(xlUp).Offset(1)
        i = i + 1
      Loop
      Application.ScreenUpdating = True
End Sub

Sub MergeData_By_For_Next실무형()
      Dim i As Long
      Dim rng As Range
      
      Application.ScreenUpdating = False
      
      Sheet1.Cells.Clear
      
      Sheet1.Range("a1:f1") = Array("월", "필드1", "필드2", "필드3", "필드4", "필드5")
      For i = 2 To Worksheets.Count
            Sheets(i).Range("a1").CurrentRegion.Copy _
            Sheet1.Cells(Rows.Count, "B").End(xlUp).Offset(1)
            
            Set rng = Sheet1.Range("a1").CurrentRegion
            rng.SpecialCells(xlCellTypeBlanks) = Sheets(i).Name
      Next
      Application.ScreenUpdating = True
End Sub

https://www.youtube.com/watch?v=lo7x3cG7rLI&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=89

엑셀 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 #46 / Replace 메서드 [VBA]
- 유령문자....
-
Dim rng as range
Dim lT
Dim e

Set rng =range("A1").CurrentRegion
lT = Array(ChrW(160),ChrW(13),ChrW(10))

For Each E In lT
   rng.Replace e, ""
Next

End Sub




https://www.youtube.com/watch?v=LOBxQDDsoIY&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=46

Array(배열)1

[개념]
1개의 변수에 여러 개의 값을 저장하여 활용할 수 있는 자료 구조
Array미적용시
5개 과목(국어,영어,수학,과학,체육)이 있는데, 과목명을 변수에 담아봅시다.
과목이 모두 5개이고 과목명이 문자이니까...
5개의 문자변수를 정의해야 하겠죠
 Dim Subject1 As String
 Dim Subject2 As String
 ....
 ....
 Dim Subject5 As String
 Subject1 = "국어"
 ....
 ....
 Subject5 = "체육"

Array적용시
 Dim Subject(1 to 5) As String
 Subject(1) = "국어"
 ....
 ....
 Subject(5) = "체육"

[Array변수를 정의하는 방법]
방식1 : 
Dim 배열변수(배열크기) As 변수타입
Dim MayArray(5) As String

방식2 :
Dim 배열변수(시작번호 to 끝번호) As 변수타입
Dim MyArray(1 to 5) As String


[Array변수에 값을 저장하는 방법]
방식1(Dim MayArray(5) As String)로 한 경우 :
MyArray(0) = "국어"    '처음 시작번호는 0,  1이 아님!!!!
....
MyArray(4) = "체육"

방식2(Dim MyArray(1 to 5) As String)로 한 경우 :
MyArray(1) = "국어"     '처음 시작번호는 내가 지정한 1!!!
....
MyArray(5) = "체육"


[Array변수에 저장된 값을 불러오는 방법]
Option Explicit 
Sub 배열값 불러오기()
  Dim MyArray(5) As String
         MyArray(0) = "국어"
         MyArray(1) = "영어"
         MyArray(2) = "수학"
         MyArray(3) = "과학"
         MyArray(4) = "체육"
         MsgBox MyArray(1)     '영어가 출력됨
End Sub

https://blog.naver.com/mydarlingharbour/223007267848