VBA Tip 실무 - ScriptingDictionary 대용량 데이터 다루시는 분! 무조건 보셔야 합니다. 안보면 후회합니다.

[@임선묵-s7z]

믿고 보고 듣는 엑사남님 강의

[@Fanta_Louis]

와 이때까지 본 엑셀 유튜버중에 가장 깔끔하고 쉽게 설명 해주시네요 최곱니다

[@excelloveman-3399]

감사합니다

[@우한국-l4s]

업무에 많은 도움이 되었습니다. 감사합니다.

[@jeongjaelee9680]

항상 아이템을 배열로 받았는데 ㅎ 이런 방법도 있다는 걸 짚어주셔서 너무 감사드립니다^^!

[@excelloveman-3399]

네 배열로 받아도 이미 실력자시네요 필요에 따라서 편한방법 사용하시면 됩니다 감사합니다 ^^

[@항상웃는넘]

실력이 안되서 for문으로만 올려봅니다.. Sub test() Dim i As Long Dim j As Long Dim lngA As Long Dim lastRow As Long Range("C2:C17").AdvancedFilter xlFilterCopy, Range("C2"), Range("J2"), True lastRow = Range("J2").End(xlDown).Row For i = 3 To lastRow lngA = 0 For j = 3 To 17 If Range("J" & i) = Range("C" & j) Then lngA = lngA + 1 Range("J" & i).Offset(, lngA) = Range("D" & j) End If Next j Next i End Sub

[@smcha9753]

강의 정말 재밌게 보고 있습니다. 배열을 이용해봤습니다. Option Explicit Option Base 1 Sub HomeWork() Dim i As Long Dim j As Long Dim k As Long Dim V() Dim lngR As Long Dim lngJ As Long Dim rngD As Range lngR = Cells(Rows.Count, 3).End(xlUp).Row Set rngD = Range("C2:C" & lngR) Cells(2, 11).CurrentRegion.Offset(1, 1).Clear rngD.AdvancedFilter xlFilterCopy, Range("C2"), Range("J2"), True '지역의 중복제거 lngJ = Cells(Rows.Count, "J").End(xlUp).Row For j = 3 To lngJ k = 0 For i = 3 To lngR If Range("J" & j) = Range("C" & i) Then k = k + 1 ReDim Preserve V(1, k) V(1, k) = Range("C" & i).Offset(0, 1) End If Next i Range("K" & j).Resize(1, k) = V Erase V Next j With Range("J2").CurrentRegion .Borders.LineStyle = 1 .HorizontalAlignment = xlCenter End With End Sub

[@간첩-l9n]

와 요즘 이거 연구하고 있었는데.. 이거 완전 감동인데요

[@excelloveman-3399]

네 도움 되시면 좋겠네요 ^^

[@뽀리너죠]

피벗등을 손쉽게 할 수 있는 구문이군요. 매번 피벗 하나 짤때마다 오래 걸렸는데 시간을 줄일 수 있는 좋은 방법 같습니다. 숙제는 총 3가지 방법으로 진행하였으며, 배열을 이용해서, uinon을 이용해서, DB를 이용해서 동일하게 작업을 진행하였습니다. 1. 배열을 이용할때에는 구문이 너무 길어져서... 굉장히 지저분하고 생각보다 어려웠습니다. 원본데이터 정렬을 해놔야 배열의 순서를 찾아 저장할 수 있다는 단점이 있기도 하여 더 길어졌습니다. 단, 시간이 상대적으로 빠르다는 느낌을 받았으며, 제가 가장 많이 사용하는 방법이라 저는 이해하기 쉬웠으나... 다른 사람이 제 코딩을 보면... 절대 모르겠다는 생각이 들더군요. 2. Union을 이용할때에는 우선 배열보다는 간결하였지만, 상대적으로 많이 느리다는 생각이 들었습니다. 단편적으로 생각해도 하나의 셀을 확인하고 다음셀 확인하고 하는 작업들이 오래걸릴 것 같다라는 생각이 듭니다. Union도 평소에 많이 사용하던 코딩이라 저는 이해하기 쉬웠지만, 속도로 봤을때는 비효율적일거 같다라고 생각했습니다. 3. DB를 이용할때에는 아직 강의가 더 이루어지지 않아서 부족한 실력으로 나름 열심히 해보았습니다. 첫번째 행이 칼럼명이 되야 하므로 첫번재 행을 삭제한 후 해볼까 하다가.. 다른 sub을 이용하거나 나중에는 삭제하지 않아도 DB를 사용할 수 있도록 별도의 시트를 만들어 DB 테이블을 만들었습니다. Function을 이용하여 시트 여부를 확인하여 오류가 나지 않도록 하였습니다. 오늘도 감사합니다. 좋은거 배우고 갑니다.

[@뽀리너죠]

Sub Scripting_Dictionary_array() Dim rngD As Range Dim rngT As Range Dim lngTemp As Long Dim MaxV As Long Dim lngRi As Long Dim lngRj As Long Dim i As Long Dim j As Long Dim V() Dim Vm() If Range("J3") "" Then Range("J3").CurrentRegion.Offset(1, 0).ClearContents End If lngRi = Cells(Rows.Count, "D").End(xlUp).Row '' 원본데이터 끝값 찾기 Set rngD = Range("C2:D" & lngRi) '' 원본데이터 값 Range 잡기 rngD.Sort key1:=Range("D3"), order1:=xlAscending, _ key2:=Range("C3"), order2:=xlAscending, _ Header:=xlYes '' 원본데이터 오름차순 정리 Range("C3:C" & lngRi).Copy Range("J3").PasteSpecial xlPasteValues '' 결과데이터 중 지역 붙여넣기 lngRj = Cells(Rows.Count, "J").End(xlUp).Row '' 결과데이터 중 지역 데이터 끝값 찾기 Range("J3:J" & lngRj).RemoveDuplicates Columns:=1 '' 결제데이터 중 지역 데이터 중복 제거 lngRj = Cells(Rows.Count, "J").End(xlUp).Row '' 중복 제거 된 결과데이터 중 지역 끝값 찾기 For j = 3 To lngRj '' 지역 별 countif 갯수의 최대 값 찾기 ReDim Preserve Vm(lngRj - 2) Vm(j - 2) = Application.CountIf(Range("C3:C" & lngRi), Range("J" & j)) Next j MaxV = Application.Max(Vm()) '' 배열에 사용할 끝값 저장 lngTemp = 1 '' 배열에 사용할 temp 값 저장 ReDim Preserve V(lngRj, MaxV) '' 배열(결과 데이터 지역 끝값, 배열에 사용할 데이터 끝값) For i = 3 To lngRi For j = 3 To lngRj If Range("C" & i) = Range("J" & j) Then '' 원본데이터와 결과데이터 값이 같을 경우 V(j - 2, lngTemp) = Range("D" & i) '' 배열에 값을 순서대로 저장 lngTemp = lngTemp + 1 If Range("C" & i) Range("C" & i + 1) Then '' 원본데이터의 아래의 데이터와 다를 경우 배열값의 줄바꿈을 위해 lngTemp 값 변경 lngTemp = 1 End If End If Next j Next i Range("K3").Resize(3, MaxV) = V() '' K열에 배열값 저장 With Range("J3").CurrentRegion '' 결과 데이터에 표 그리기 .Borders.LineStyle = 1 .HorizontalAlignment = xlCenter End With End Sub

[@뽀리너죠]

Sub Scripting_Dictionary_union() Dim lngRi As Long Dim lngRj As Long Dim rngD As Range Dim i As Long Dim j As Long If Range("J3") "" Then Range("J3").CurrentRegion.Offset(1, 0).ClearContents End If lngRi = Cells(Rows.Count, "D").End(xlUp).Row '' 원본데이터 끝값 찾기 Range("C3:C" & lngRi).Copy Range("J3").PasteSpecial xlPasteValues '' 결과데이터 중 지역 붙여넣기 lngRj = Cells(Rows.Count, "J").End(xlUp).Row '' 결과데이터 중 지역 데이터 끝값 찾기 Range("J3:J" & lngRj).RemoveDuplicates Columns:=1 '' 결제데이터 중 지역 데이터 중복 제거 lngRj = Cells(Rows.Count, "J").End(xlUp).Row '' 중복 제거 된 결과데이터 중 지역 끝값 찾기 For j = 3 To lngRj For i = 3 To lngRi If Range("C" & i) = Range("J" & j) Then '' 원본데이터와 결과데이터가 같으면 If rngD Is Nothing Then Set rngD = Range("D" & i) '' Union을 이용하여 rngD에 저장 Else Set rngD = Union(rngD, Range("D" & i)) '' 기존 Union값과 함께 rngD에 저장 End If End If Next i rngD.Copy '' rngD값을 복사하여, 행열을 바꾸어 저장 Range("J" & j).Offset(0, 1).PasteSpecial , Transpose:=True Set rngD = Nothing Next j With Range("J3").CurrentRegion '' 결과 데이터에 표 그리기 .Borders.LineStyle = 1 .HorizontalAlignment = xlCenter End With End Sub

[@뽀리너죠]

Sub Scripting_Dictionary_db() Dim Rs As New ADODB.Recordset Dim strPath As String Dim strSQL As String Dim strConn As String Dim lngRi As Long Dim lngRj As Long Dim lngR As Long Dim rngD As Range Dim i As Long Dim j As Long Dim ws As Worksheet If Range("J2") "" Then Range("J2").CurrentRegion.Offset(1, 0).ClearContents End If lngRi = Cells(Rows.Count, "D").End(xlUp).Row '' 원본데이터 끝값 찾기 If sheetExists("db") = False Then Sheets.Add '' 작업 시트 만들기 ActiveSheet.Name = "db" End If Sheets("과제물").Range("C2:D" & lngRi).Copy Sheets("db").Range("A1").PasteSpecial xlPasteValues Sheets("과제물").Select Range("C3:C" & lngRi).Copy Range("J3").PasteSpecial xlPasteValues '' 결과데이터 중 지역 붙여넣기 lngRj = Cells(Rows.Count, "J").End(xlUp).Row '' 결과데이터 중 지역 데이터 끝값 찾기 Range("J3:J" & lngRj).RemoveDuplicates Columns:=1 '' 결제데이터 중 지역 데이터 중복 제거 lngRj = Cells(Rows.Count, "J").End(xlUp).Row '' 중복 제거 된 결과데이터 중 지역 끝값 찾기 strPath = ThisWorkbook.FullName '' DB..... strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & strPath & ";" & _ "Extended Properties=Excel 12.0;" For j = 3 To lngRj strSQL = "SELECT 값 FROM [db$] WHERE 지역='" & Sheets("과제물").Range("J" & j) & "'" Rs.Open strSQL, strConn Sheets("db").Range("Z1").CopyFromRecordset Rs lngR = Sheets("db").Cells(Rows.Count, "Z").End(xlUp).Row Sheets("db").Range("Z1:Z" & lngR).Copy Sheets("과제물").Range("K" & j).PasteSpecial xlPasteValues, Transpose:=True Sheets("db").Range("Z1:Z" & lngR).Clear Rs.Close Set Rs = Nothing Next j With Sheets("과제물").Range("J3").CurrentRegion '' 결과 데이터에 표 그리기 .Borders.LineStyle = 1 .HorizontalAlignment = xlCenter End With End Sub Function sheetExists(shtName As String, Optional wb As Workbook) As Boolean Dim sht As Worksheet If wb Is Nothing Then Set wb = ThisWorkbook On Error Resume Next Set sht = wb.Sheets(shtName) On Error GoTo 0 sheetExists = Not sht Is Nothing End Function

[@excelloveman-3399]

항상 감사합니다

[@davidsarilee]

딱 필요한 부분이었는데 정말 감사합니다.

[@excelloveman-3399]

이런 댓글 너무 좋습니다 꼭 도움 되시길 바랍니다

[@benben-kh6in]

우선 첫번째 방법으로 푼 과제입니다 엑사남님 ㅎㅎ. 우선 저는 중복제거를 활용해서 지역의 유니크 값들을 J열에 엑셀시트에서 붙여 놓고 아래 VBA구문을 작성했습니다. 생각보다 짧게 작성되었어요. ㅎㅎ Sub test02() Dim strR As String Dim lngT As Range Dim lngE As Range Dim lng1 As Long Dim lng2 As Long Dim lng3 As Long Set lngT = Range("C3:C" & Cells(Rows.Count, 3).End(xlUp).Row) For Each lngE In lngT If lngE = Range("J3") Then Cells(3, lng1 + 11) = lngE.Offset(0, 1) lng1 = lng1 + 1 ElseIf lngE = Range("J4") Then Cells(4, lng2 + 11) = lngE.Offset(0, 1) lng2 = lng2 + 1 ElseIf lngE = Range("J5") Then Cells(5, lng3 + 11) = lngE.Offset(0, 1) lng3 = lng3 + 1 End If Next lngE End Sub 배열로도 한번 풀어보겠습니다. 지난 시간에 배운 배열 복습할겸.. ㅎㅎ 강의 감사합니다

[@뽀리너죠]

배열로 만든 숙제 복습합니다. 옛날 코딩보다 좀 나아졌네요. Sub noDict() Dim Dict As New Dictionary Dim lngR As Long Dim i As Long Dim j As Long Dim lngTemp As Long Dim v As Variant lngR = Range("C1000").End(xlUp).Row v = Range("C3:D" & lngR) Range("J3").Resize(UBound(v), 1) = Application.Index(v, i, 1) Range("J3").Resize(UBound(v), 1).RemoveDuplicates Columns:=1, Header:=xlNo For i = 3 To Range("J1000").End(xlUp).Row lngTemp = 0 For j = 3 To lngR If Range("J" & i) = Range("C" & j) Then lngTemp = lngTemp + 1 Cells(i, 10).Offset(0, lngTemp) = Range("D" & j) End If Next j Next i With Range("J1").CurrentRegion .Borders.LineStyle = 1 .HorizontalAlignment = xlCenter End With End Sub

[@excelloveman-3399]

볼수록 점점더 점점더 ㅎㅎ 진짜 13번 보실려구요?

[@뽀리너죠]

@@excelloveman-3399 13번 아직 멀었습니다 ㅠㅠㅠㅠㅠㅠㅠㅠㅠㅠ 그래도 요즘 강의가 덜 올라와서 13번 보기 시간은 벌고 있습니다 ㅎㅎㅎ

[@excelloveman-3399]

@@뽀리너죠 강의 안올린다고 혼내키는거 아니죠? ㅎㅎ

[@tvletsplaywithsoy4178]

Option Explicit Sub 고유값으로_나열하기_2() Dim rngAll As Range Dim rngJ As Range Dim rngC As Range Dim intJ As Integer Dim i, j, r As Integer Application.ScreenUpdating = False Set rngAll = Range("c2:c" & Cells(Rows.Count, "c").End(3).Row) Range("j2").CurrentRegion.Offset(1, 0).Clear rngAll.Copy rngAll.Offset(0, 7) '= 지역항목을 복사하여 +7열에 붙혀넣기해라 rngAll.Offset(0, 7).RemoveDuplicates _ Columns:=1, Header:=xlYes '= 붙혀넣기 영역에서 중복제거를 해서 고유 항목을 뽑아라 intJ = Range("j2").End(4).Row '= 중복제거한 고유항목의 마지막 열값을 반환해라 Set rngJ = rngAll.Offset(1) '= 고유항목을 영역으로 잡고 For i = 3 To intJ '= 고유항목의 첫번째 행인 3부터 마지막행까지 반복해라 For Each rngC In rngJ '= 전체항목만큼 반복하는데 If Cells(i, 10) = rngC Then '= 고유항목과 전제항목의 rngC와 같이 같다면 r = r + 1 '= 출력한 열의 변수 Cells(i, 10 + r) = rngC.Next '= j열부터 r만큼 증가하여 열에 값을 반환한다. End If Next rngC r = 0 '= 열의 증가값 r의 변수를 초기화 한다. Next i With Range("j2").CurrentRegion .Borders.LineStyle = 1 '= 고유항목의 전체영역을 선을 긋고 .HorizontalAlignment = xlCenter '= 가운데 정렬을 해라 End With End Sub

[@excelloveman-3399]

일반적인 방법의 정석입니다 귯! ^^

[@danil-qy2mz]

이걸로 20년 업체별 월별 판매 현황을 만들려고 하는데요 사전의 뜻에 해당하는부분에다가 월별 판매금액을 구분지어서 넣을수 있을까요? 예를 들면 a업체 1월 2월3월 판매금액 이런식으로요

[@excelloveman-3399]

안녕하세요 강의 관련 질문은 아래 주소의 오픈채팅방 이용 부탁드립니다. 파일이나 캡쳐본으로 서로 전달해야 빠른 풀이 및 이해가 가능합니드 제 강의를 듣는 구독자 분들이 VBA 학습을 위해 만든 방입니다. 입장 후 인사와 공지 준수는 필수 입니다^^ 학습 하시는데 많은 도움이 되실거에요. 유튜브 '엑사남'의 Excel VBA 함께하기 open.kakao.com/o/glXWEB3b

[@hiras1889]

Dictionary 강의 감사합니다.속도는 정말 빠른것 같습니다. 혹시 Exists의 일치값이 아닌, 부분일치(포함 : *값,값*,*값*)과 같이 Dictionary 를 활용 (배열 find,vlookup,like는 이미 사용중입니다.) 해서 찾기를 해서 찾을수 있는 방법이 있는지 궁금합니다.

[@excelloveman-3399]

KEY 값이 유니크해야 하기 때문에 애매한 like 값으로 잡을수는 없고요 부분일치에 해당하는 열을 따로 key로 만들어서 사용하시면 될거 같네요

[@tvletsplaywithsoy4178]

Option Explicit Sub 고유값으로_재배열하기_3() Dim newC As New Collection '= 고유 항목을 추출하기 위해 new collection 사용하기 위한 변수 Dim varTemp() '= 고유 항목을 담을 동적 배열변수 Dim varC(14) '= 전체 항목을 담을 정적 배열변수 Dim varD(14) '= 전체 항목의 값을 담을 정적 배열변수 Dim rngAll As Range ' Dim rngJ As Range Dim rngC As Range Dim intJ As Integer Dim i, j, r, x As Integer Application.ScreenUpdating = False Set rngAll = Range("c2", Cells(Rows.Count, "c").End(3)) Range("j2").CurrentRegion.Offset(1, 0).Clear '===================================== 뉴 컬렉션으로 고유값을 뽑기 위한 구문 ======================================================== On Error Resume Next For Each rngC In rngAll.Offset(1) If Len(rngC) Then '= 전체항목중 셀값이 있다면 newC.Add rngC, rngC '= 뉴컬렉션에 추가해라 varC(r) = rngC '= 전체항목을 담을 배열변수에 rngC 를 r번째로 순차적으로 채워라 varD(r) = rngC.Next '= 전체항목의 값을 담을 배열변수에 rngC r번째로 순차적으로 채워라 r = r + 1 End If Next rngC On Error GoTo 0 '=========================================================================================================================== ReDim varTemp(newC.Count - 1) '= 재배열 뉴 컬렉션은 1부터 시작하고 배열은 0부터 시작하기에 -1을 해라 For i = 0 To UBound(varTemp) '= 고유항목을 추출한 만큼 반복해라 varTemp(i) = newC(i + 1) '= 뉴컬렉션의 값을 고유항목을 담을 배열에 넣어라 For j = 0 To UBound(varD) If varTemp(i) = varC(j) Then '= 고유항목과 전체항목이 같으면 x = x + 1 '= 열을 x만큼 증가해라 Cells(i + 3, 10) = varTemp(i) '= 고유항목의 열에 고유항목을 넣고 Cells(i + 3, 10 + x) = varD(j) '= 열을 하나씩 추가하며 해당 값을 출력해라 End If Next j x = 0 Next i With Range("j2").CurrentRegion .Borders.LineStyle = 1 '= 고유항목의 전체영역을 선을 긋고 .HorizontalAlignment = xlCenter '= 가운데 정렬을 해라 End With End Sub

[@excelloveman-3399]

컬렉션을 사용하셨군요 ㅎㅎ

[@tvletsplaywithsoy4178]

Option Explicit Sub 고유값으로_나열하기() Dim rngAll As Range Dim rngJ, rngk As Range Dim rngC As Range Dim intJ As Integer Dim strTemp As String Dim i, j, k As Integer Application.ScreenUpdating = False Set rngAll = Range("c2:c" & Cells(Rows.Count, "c").End(3).Row) Range("j2").CurrentRegion.Offset(1, 0).Clear intJ = 5 rngAll.AdvancedFilter xlFilterCopy, Cells(2, 3), Range("j2"), Unique:=1 '= 고급필터로 고유값 가져오기 Set rngJ = rngAll.Offset(1) For i = 3 To intJ For Each rngC In rngJ If Range("j" & i) = rngC Then '= 고유항목과 rngC 가 같고 If strTemp "" Then '= 값을 저장할 strTemp 빈셀이 아니라면 strTemp = strTemp & "," & rngC.Next '= strTemp 에 rngC의 옆에값 즉 값항목을 가져와라 (rngC.next) Else '= 고유항목과 rngC 가 같지만 strTemp = rngC.Next '= 값을 저장할 strTemp가 빈셀이면 strTemp에 rng.next 값을 초기값으로 잡아라 End If End If Next rngC Range("j" & i).Next = strTemp '= 고유항목의 지역값 옆에 strTemp값을 추출해라 strTemp = "" '= 다음 고유항목의 지역값을 불러오기 위해 strTemp를 초기화해라 Next i Set rngk = Range("k3:k" & Cells(Rows.Count, "k").End(3).Row) '= 고유항목의 값의 전체영역을 rngK로설정하고 rngk.TextToColumns Destination:=Range("k3"), comma:=True '= rngK를 k3의 열을 기준으로 콤마로 분리해라궇 With rngk.CurrentRegion .Borders.LineStyle = 1 '= 고유항목의 전체영역을 선을 긋고 .HorizontalAlignment = xlCenter '= 가운데 정렬을 해라 End With End Sub

[@excelloveman-3399]

이건 뭐 ... 말이 필요 없네요 ^^

[@tvletsplaywithsoy4178]

읔 이따봐야겠어요 캐릭터 ㅋ

[@excelloveman-3399]

네 감사요^^