엑셀 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 #37 / 행삽입_변형 [VBA]

1. 원하는 개수 만큼 행 삽입

Dim i As Long, lR As Long
Dim j As Long

lR = Cells(Rows.Count, "A").End(xlUp).Row

For i = lR To 2 Step -1
    If Len(Cells(i, "B")) Then                   ' Cells(i, "B")에 값이 있다면 아래 구문 반복해
            For j = 1 To Cells(i, "B").Value   '1부터 B열의 i행의 값만큼 아래 구문을 반복해!!!
                Cells(i, "A").Offset(1).Resize(, 6).Insert Shift:=xlDown
            Next
    End If
Next

2. 그룹별 행 삽입

Dim i As Long, lR As Long
Dim j As Long

lR = Cells(Rows.Count, "A").End(xlUp).Row

For i = lR To 2 Step -1
    If i <> lR Then
        If Cells(i, "A") <> Cells(i + 1, "A") Then    '지금 행 값과 다음 행의 값이 다르면 다음 구문을 처리해!
              Cells(i, "A").Offset(1).Resize(, 6).Insert Shift:=xlDown
        End If
    End If
Next

https://www.youtube.com/watch?v=fFe0JI2r6UM&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=37

엑셀 VBA #20 / Like 연산자_예제2 [VBA]

Like함수 구조 :
If 문자셀 Like 패턴 Then.......

Sub Like연산자_예제2()

Dim i As Long, j As Long
Dim cn As Long

cn = Range("a1").CurrentRegion.Rows.Count
 For i = 2 To cn
      For j = 1 To Len(Cells(i, "a"))
            If Mid(Cells(i, "a"), j, 5) Like "D####" Then
                  Cells(i, "b") = Mid(Cells(i, "a"), j, 5)
            End If
      Next
Next

End Sub

https://www.youtube.com/watch?v=OG7qR-9IsNA&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=20

엑셀 VBA #19 / Like 연산자_예제1 [VBA]

Len(Range("a2"))
a2셀 값의 글자 개수를 알려줘!!!

Mid(Range("a2"), 1, 1)
mid함수 지정 셀 값의 왼쪽에서부터 첫번째 위치한 글자에서부터 글자 하나만 보여줘!!!

 Mid(Range("a2"), 4, 4)
a2셀의 값에서 왼쪽에서 4번째부터 시작하여 4글자만 보여줘!!!

Sub Like연산자_예제()

Dim i As Long
Dim lT As String

For i = 1 To Len(Range("A2"))
      If Mid(Range("a2"), i, 1) Like "[가-힣]" Then
            lT = lT & Mid(Range("a2"), i, 1)
      End If
Next

Range("b2") = lT
'If Len(lT) then Range("b2")=lT  
'위 코드보다 이 코드 좋다는데....
'If Len(lT) then 의미 : lT에 값이 있다면!

End Sub

VBA#37강 Len구문 사용례 참고

    If Len(Cells(i, "B")) Then          ' Cells(i, "B")에 값이 있다면 아래 구문 반복해

https://www.youtube.com/watch?v=SumpOywJJqY&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=19

엑셀 VBA #18 / Like 연산자 [VBA]

Like함수 구조 :
If 문자셀 Like 패턴 Then.......

If 문자셀 Like [A-Z] Then.......     대문자 영문이라면
If 문자셀 Like [a-z] Then.......     소문자 영문이라면
If 문자셀 Like [가-힣] Then.......     한글이라면
If 문자셀 Like [!가-힣] Then.......     한글 아니라면
If 문자셀 Like [0-9] Then.......     숫자라면
If 문자셀 Like "A*" Then.......     대문자A로 시작하는 모든 글자라면
If 문자셀 Like "A?" Then.......     대문자A로 시작하면서 글자 하나가 따라오면
If 문자셀 Like "A#" Then.......     대문자A로 시작하면서 숫자 하나가 따라오면
If Not 문자셀 Like "A*" Then.......     대문자A로 시작하는 모든 글자가 아니라면

A2셀 값이 "A1" 이 맞으며 글자수가 2개라면 메시지박스에 "OK"가 나오는 코드

Sub Like연산자1()

If Range("A2") = "A1" And Len(Range("A2")) = 2 Then MsgBox "OK"
'len함수 : 문자의 개수 파악하는 함수

End Sub

A3셀의 값이 위 그림의 규칙에 부합하면 메시지박스에 "OK"가 나오는 코드

Sub Like연산자2()

If Range("A3") Like "###-[A-D][A-D][A-D]###" Then MsgBox "OK"

End Sub

https://www.youtube.com/watch?v=bnUIgnBITL0&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=19