엑셀 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 #51 / 중복데이터 처리_4 [VBA] - 사용자정의함수

Sub 중복데이터삭제_단계2()

Dim rng As Range, rngX As Range
Dim i As Long, j As Long
Dim cntR As Long, cntC As Long
Dim strI As String, strJ As String

Set rng = Range("A3", Cells(Rows.Count, "D").End(xlUp))

cntR = rng.Rows.Count
cntC = rng.Columns.Count

For i = 1 To cntR - 1
      strI = fnMerge(rng, i)
      For j = i + 1 To cntR
                   strJ = fnMerge(rng, j)
                   If strI = strJ Then
                                  If rngX Is Nothing Then
                                       Set rngX = rng(j, "A").Resize(1, cntC)
                                  Else
                                       Set rngX = Union(rngX, rng(j, "A").Resize(1, cntC))
                                  End If
                   End If
       Next
Next

If rngX Is Nothing = 0 Then rngX.Delete
End Sub

Function fnMerge(rng As Range, i As Long) As String
Dim col As Long, k As Long
Dim str As String

col = rng.Columns.Count
    For k = 1 To col
        str = str & rng(i, k)                        '?????이해 안됨
    Next
 fnMerge = str
End Function

https://www.youtube.com/watch?v=EkGRLek1arM&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=51

엑셀 VBA #34 / 사용자정의 함수 [VBA]

엑셀 VBA #50 / 중복데이터 처리_3 [VBA]

엑셀 VBA #50 / 중복데이터 처리_3 [VBA]

Sub 중복데이타삭제_단계1()

Dim rng As Range
Dim lR As Long, lC As Long
Dim i As Long, j As Long
Dim rngX As Range

Set rng = Range("A3", Cells(Rows.Count, "D").End(xlUp))

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

rng(1, lC + 1).Resize(rng.Rows.Count, 1) = "=A3&B3&C3&D3"

For i = 3 To lR - 1
    For j = i + 1 To lR
        If Cells(i, "E") = Cells(j, "E") Then
            If rngX Is Nothing Then
                Set rngX = Cells(j, "A").Resize(1, lC + 1)
            Else
                Set rngX = Union(rngX, Cells(j, "A").Resize(1, lC + 1))
            End If
        End If
    Next
Next

If rngX Is Nothing = 0 Then rngX.Delete
Columns("e") = ""

End Sub

https://www.youtube.com/watch?v=i1vBAAKTBhY&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=50

엑셀 VBA #40 / 행 삭제_개선1 [VBA] - Union

엑셀 VBA #08 / 셀 범위 선택하기_3 [VBA] - Union

엑셀 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 #48 / 중복데이터 처리_2 [VBA] - 신규항목 추출

Dim ro As Range, rc As Range

Set ro = Range("A2", Range("A2").End(xlDown))
Set rc = Range("D2", Cells(Rows.Count, "D").End(xlUp))

For Each c In rc
    If Application.CountIf(ro, c) = 0 Then
        c.Resize(, 2).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1) 

              ' end(xlup).offset(1) =end(3)(2)와 같음
    End If
Next

위 코드 중 'Application.CountIf(ro, c) = 0' 구문은 아래 그림 워크시트 Countif함수식을 참고하여 만든 구문임.

For Each c In rc
If Application.CountIf(ro, c) = 0 Then
1번 코드 : c.Resize(, 2).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1) 을

2번 코드 : c.Resize(, 2).Copy Range("A12").Offset(1) 으로 대체하면 안될까.......안됨!!!!

2번 코드를 실행하면 값이 'J-1    44'만 보여짐.
이는 For Each~Next구문을 순환하면서 맨 먼저 나온 신규항목 값인 'E-1    22'이  

"Range("A12").OffSet(1)"에 의해 'J-1    44'을 대체됨

https://www.youtube.com/watch?v=0ZvPQ_TGcm8&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=48

엑셀 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 #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

엑셀 VBA #45 / Find메서드_변형3 [VBA]

Dim sh8 As Worksheet, sh7 As Worksheet
Dim rng As Range, cf As Range
Dim ad As String

Set sh8 = Sheets("2018")
Set sh7 = Sheets("2017")
Set rng = sh7.Range("B3", sh7.Cells(Rows.Count, "B").End(xlUp))

'Cells(Rows.Count,"B")만 쓰면 오류 발생가능성 있으므로, 시트명 sh7를 붙힐 것

For Each c In sh8.Range("B3", sh8.Cells(Rows.Count, "B").End(xlUp))
    Set cf = rng.Find(c, , , xlWhole)
    If Not cf Is Nothing Then
        ad = cf.Address
        Do
            c.Offset(, 2) = "○"
            Set ccf = rng.FindNext(cf)
        
        Loop Until cf.Address = ad
    End If

https://www.youtube.com/watch?v=hSXQKoyhXNE&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=45