TRIM (3)
엑셀 VBA #52 / 중복데이터 처리_5 [VBA]-고유항목별 합계구하기
반응형

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

vba#52.xlsm
0.81MB


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


반응형
  Comments,     Trackbacks
엑셀 VBA #47 / 중복데이터 처리_1 [VBA]- Removeduplicates. 고급필터. New Collection
반응형

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

vba#47.xlsm
0.02MB



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)

반응형
  Comments,     Trackbacks
엑셀 VBA #26 / For Each~Next_2 [VBA] - New Collection
반응형

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

 

vba#26.xlsm
0.02MB

 

핵심정리

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

 

 

 

반응형
  Comments,     Trackbacks
최근 작성 글
최근 작성 댓글
최근 작성 트랙백
프로필
공지사항
글 보관함
캘린더
«   2024/12   »
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31
TODAY TOTAL