파일을 만든 날짜를 보니 21.05.20에 만든 파일이다.
이걸 어떤분이 질문했던 내용으로 알고 있다.
물류에서 쇼핑몰 상품리스트가 들어왔을 때 이걸 주문자명으로 분류하고 다시 상품으로 분류하고 마지막으로 상품갯수로 분류하는 것이다.
주문 상품을 어떻게 분류할지의 알고리즘을 짜는게 관건이다.
또한 주문자의 상품의 종류와 갯수에 계속 배열의 크기가 달라지기 때문에
Vall( 1 to 7 , 1 to N) -> WorksheetFunction.transpose(Vall)로 결과 출력을 해야한다.
동적배열은 행은 증가되지 않고 열방향으로만 크기가 증가된다.(정말 중요하다)
너무너무 중요하고 아름다운 코드이다...꼭 기억해두길 바란다.
Option Explicit
Sub 상품나누기()
Dim Vall() '= 분리된 값을 담을 배열
Dim rngX As Range: Set rngX = [a2] '= 데이터 영역을 증가할 영역
Dim i&, j&, q&, N&, Cnt&: Cnt = 1 '= i는 패턴갯수 / j는 상품별 반복변수
Dim Reg As Object: Set Reg = CreateObject("vbscript.regexp")
Dim Mat As Object '= 정규식 선언
Dim Splt '= 일치된 패턴을 분리해서 담을 변수
Dim X&
With Reg '= 정규식 패턴
'= 상품(빈칸)(알파벳):(숫자)개
.Global = True
.Pattern = "(상품\s\w\:\d+개)"
End With
Do While rngX.Value <> Empty '= 데이터 영역이 빈공간 일때까지 반복해라
If Reg.test(rngX.Offset(, 5)) = True Then '= 주문상품이 정규식 패턴과 일치하면
Set Mat = Reg.Execute(rngX.Offset(, 5)) '= Mat에 담아라
For i = 0 To Mat.Count - 1 '= Mat의 갯수만큼 반복해라
'= 주문상품의 상품의 종류만큼 반복해라
Splt = Split(Mat(i), ":") '= 콜론을 기준으로 나눠라
X = Val(Replace(Splt(1), "개", "")) '= 2개 , 3개로 나눠진 값을 '개'를 없애라
N = N + X '= 주문자가 총 몇개의 상품을 주문했는지 카운팅
ReDim Preserve Vall(1 To 7, 1 To N)
'= Preserve는 행 증가는 안되고 행 증가로만 된다.(중요)
'= 성명 아이디 연락처 주소 메시지 상품 갯수 이렇게 도출되어야 하는데
'= 상품의 갯수만큼 행으로 크기가 커져야 하기 때문에
'= Vall(1 to N, 1 to 7) 이렇게 해야 하는데
'= 행방향으로는 증가가 되지 않기 때문에 WorksheetFunction.transpose(vall)로 해야하기 때문에
'= ReDim Preserve Vall(1 To 7, 1 To N)으로 해야 한다.
'= 각 개인별 상품별 갯수별로 담는 구문
For j = 1 To X '= X는 각 개별 상품의 갯수이다.
For q = 0 To 4 '= 성명 / 아이디 / 연락처 / 주소 / 메시지
Vall(q + 1, Cnt) = rngX.Offset(, q)
Next q
Vall(6, Cnt) = Splt(0) '= 상품명
Vall(7, Cnt) = Splt(1) '= 상품명의 갯수
Cnt = Cnt + 1
Next j
Next i
End If
Set rngX = rngX.Offset(1) '= 다음 주문자값으로 이동
Loop
Workbooks.Add '= 새로운 워크북을 추가해라
[a1].Resize(1, 7) = Array("성명", "아이디", "연락처", "주소", "메시지", "상품", "갯수")
'= 성명부터 갯수까지 헤드를 만들어라
[a2].Resize(UBound(Vall, 2), UBound(Vall, 1)) = _
WorksheetFunction.Transpose(Vall) '= 그곳에 행과 열을 변경하여 셀에 출력해라
Columns("a:g").AutoFit '= 자동정렬
Columns("a:g").HorizontalAlignment = xlCenter '= 가운데 정렬
MsgBox "매크로가 종료되었습니다."
End Sub
오늘 이구문의 핵심은
ReDim Preserve Vall(1 To 7, 1 To N)
.
.
[a2].Resize(UBound(Vall, 2), UBound(Vall, 1)) = WorksheetFunction.Transpose(Vall)
'VBA' 카테고리의 다른 글
[VBA] 등급별 랜덤 순번과 전체순번을 구하라 (0) | 2022.04.12 |
---|---|
[VBA] VBA에는 없는 차집합 여집합 구성 (0) | 2022.04.12 |
[VBA] VAT유저폼(feat. 인천_89_회계_가나) (2) | 2022.04.10 |
[VBA] 딕셔너리 배열로 대체하기 (0) | 2022.04.08 |
[VBA] ArrayList 로 배열 고유값과 중복 횟수 구하기 (0) | 2022.04.08 |
댓글