피벗등을 손쉽게 할 수 있는 구문이군요. 매번 피벗 하나 짤때마다 오래 걸렸는데 시간을 줄일 수 있는 좋은 방법 같습니다. 숙제는 총 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 잡기
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
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 '' 중복 제거 된 결과데이터 중 지역 끝값 찾기
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
우선 첫번째 방법으로 푼 과제입니다 엑사남님 ㅎㅎ. 우선 저는 중복제거를 활용해서 지역의 유니크 값들을 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)
강의 정말 재밌게 보고 있습니다. 배열을 이용해봤습니다. 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
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
안녕하세요 강의 관련 질문은 아래 주소의 오픈채팅방 이용 부탁드립니다. 파일이나 캡쳐본으로 서로 전달해야 빠른 풀이 및 이해가 가능합니드 제 강의를 듣는 구독자 분들이 VBA 학습을 위해 만든 방입니다. 입장 후 인사와 공지 준수는 필수 입니다^^ 학습 하시는데 많은 도움이 되실거에요. 유튜브 '엑사남'의 Excel VBA 함께하기 open.kakao.com/o/glXWEB3b
Dictionary 강의 감사합니다.속도는 정말 빠른것 같습니다. 혹시 Exists의 일치값이 아닌, 부분일치(포함 : *값,값*,*값*)과 같이 Dictionary 를 활용 (배열 find,vlookup,like는 이미 사용중입니다.) 해서 찾기를 해서 찾을수 있는 방법이 있는지 궁금합니다.
실력이 안되서 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
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)
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을 해라
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
믿고 보고 듣는 엑사남님 강의
와 이때까지 본 엑셀 유튜버중에 가장 깔끔하고 쉽게 설명 해주시네요 최곱니다
감사합니다
피벗등을 손쉽게 할 수 있는 구문이군요. 매번 피벗 하나 짤때마다 오래 걸렸는데 시간을 줄일 수 있는 좋은 방법 같습니다.
숙제는 총 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
항상 감사합니다
우선 첫번째 방법으로 푼 과제입니다 엑사남님 ㅎㅎ. 우선 저는 중복제거를 활용해서 지역의 유니크 값들을 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
볼수록 점점더 점점더 ㅎㅎ
진짜 13번 보실려구요?
@@excelloveman-3399 13번 아직 멀었습니다 ㅠㅠㅠㅠㅠㅠㅠㅠㅠㅠ 그래도 요즘 강의가 덜 올라와서 13번 보기 시간은 벌고 있습니다 ㅎㅎㅎ
@@뽀리너죠 강의 안올린다고 혼내키는거 아니죠? ㅎㅎ
딱 필요한 부분이었는데
정말 감사합니다.
이런 댓글 너무 좋습니다
꼭 도움 되시길 바랍니다
강의 정말 재밌게 보고 있습니다. 배열을 이용해봤습니다.
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
이걸로 20년 업체별 월별 판매 현황을 만들려고 하는데요 사전의 뜻에 해당하는부분에다가 월별 판매금액을 구분지어서 넣을수 있을까요? 예를 들면 a업체 1월 2월3월 판매금액 이런식으로요
안녕하세요
강의 관련 질문은 아래 주소의
오픈채팅방 이용 부탁드립니다.
파일이나 캡쳐본으로 서로 전달해야
빠른 풀이 및 이해가 가능합니드
제 강의를 듣는 구독자 분들이
VBA 학습을 위해 만든 방입니다.
입장 후 인사와 공지 준수는 필수 입니다^^
학습 하시는데 많은 도움이 되실거에요.
유튜브 '엑사남'의 Excel VBA 함께하기
open.kakao.com/o/glXWEB3b
읔 이따봐야겠어요 캐릭터 ㅋ
네 감사요^^
Dictionary 강의 감사합니다.속도는 정말 빠른것 같습니다. 혹시 Exists의 일치값이 아닌, 부분일치(포함 : *값,값*,*값*)과 같이 Dictionary 를 활용 (배열 find,vlookup,like는 이미 사용중입니다.) 해서 찾기를 해서 찾을수 있는 방법이 있는지 궁금합니다.
KEY 값이 유니크해야 하기 때문에 애매한 like 값으로 잡을수는 없고요
부분일치에 해당하는 열을 따로 key로 만들어서 사용하시면 될거 같네요
실력이 안되서 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
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
일반적인 방법의 정석입니다 귯! ^^
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
이건 뭐 ... 말이 필요 없네요 ^^
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
컬렉션을 사용하셨군요 ㅎㅎ