금액은 얼마 안 되지만 최초의 VBA 코딩 알바.
한 일에 비해 적은 금액이긴 하다. 하지만 많이 배움.
코드가 길다.
상품정리 시트를 기준으로 변환1, 변환2, 변환3 파일을 만드는 작업.
각 파일마다 특징이 있다.
1. 변환1에서는 색상과 사이즈가 한셀에 콤마를 기준으로 나열되어 있다.
이것을 임시셀을 삽입해서 임시셀에 색상과 사이즈를 텍스트나누기를 한 내용을 넣고
작업을 한 후에 임시셀을 삭제하는 것이 포인트.
2. 변환2에서는 상품명을 기반으로 첫 자음을 표기하는 것이 포인트.
상품명이 도트슬립일 때 ㄷ. 로 표기하는 것이 관건인데, 문제는 알파벳이 있다는 것이다.
TOM 이라는 상품이 있으면 ㅌ. 라고 표기하는 것.
엑셀은 알파벳과 한글의 발음을 매치시키지 못하기때문에 Select Case 구문을 사용하여 알파벳의 초성을 뽑았다.
3. 변환3에서는 색상과 사이즈에서
기존 그레이,카키 라고 표시된 것을 {그레이|카키}라고 바꾸는 것이 포인트. Replace 함수를 이용해 쉽게 끝냈지만
내용이 많아서 시간이 오래 걸린 점이 함정
Option Explicit
Sub LetsGo()
Dim strPath As String, strFile As String
Dim i As Integer
'처리속도 향상
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'변환1,2,3,4 실행
fnChange1
fnChange2
fnChange3
fnChange4
Sheets(1).Select
'변환1,2,3,4 파일 저장
strPath = ThisWorkbook.Path & "\"
For i = 2 To Sheets.Count
strFile = Sheets(i).Name & ".xlsx"
'동일한 파일명이 있을 경우 기존 파일 삭제
If Dir(strPath & strFile) <> "" Then Kill strPath & strFile
Sheets(i).Copy
With ActiveWorkbook
.SaveAs Filename:=strPath & strFile
.Close
End With
Next i
'처리속도 복구
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Sub fnChange1()
Dim rngArea As Range, rngCell As Range
Dim cntColor As Integer, cntSize As Integer
Dim colorI As Integer, sizeI As Integer
Dim rngImport As Range
Dim i As Integer
Dim wsGoods As Worksheet, wS1 As Worksheet
'처리속도 향상
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'시트명 정의
Set wsGoods = Sheets("상품정리")
Set wS1 = Sheets("변환1")
'변환1 시트 기존 자료 삭제
i = wS1.Range("A1").CurrentRegion.Rows.Count
If i > 1 Then
wS1.Range("A1").Offset(1).Resize(i - 1).EntireRow.ClearContents
End If
i = 0
'상품 분류 중 빈셀을 제외한 셀영역 및 변환1 규격셀 설정
wsGoods.Select
If Range("E3") = "" Then
Set rngArea = wsGoods.Range("E2")
Else
Set rngArea = wsGoods.Range("E2", Cells(Rows.Count, "E").End(xlUp)).SpecialCells(2)
End If
Set rngImport = wS1.Cells(Rows.Count, "E").End(xlUp).Offset(1)
For Each rngCell In rngArea
With rngCell
'사이즈를 콤마 기준으로 빈셀 삽입 후 텍스트 나누기
Application.DisplayAlerts = False
With .Offset(, 6)
cntSize = Len(.Value) - Len(Replace(.Value, ",", "")) + 1
.Offset(, 1).Resize(, cntSize).Insert shift:=xlToRight
.Cells.TextToColumns Destination:=.Offset(, 1), Comma:=True
End With
'색상을 콤마 기준으로 빈셀 삽입 후 텍스트 나누기
On Error Resume Next
With .Offset(, 5)
cntColor = Len(.Value) - Len(Replace(.Value, ",", "")) + 1
.Offset(, 1).Resize(, cntColor).Insert shift:=xlToRight
.Cells.TextToColumns Destination:=.Offset(, 1), Comma:=True
End With
On Error GoTo 0
Application.DisplayAlerts = True
'색상, 사이즈별로 규격, 물품별칭 표시
For colorI = 1 To cntColor
For sizeI = 1 To cntSize
With rngImport
.Offset(i, -1) = rngCell.Offset(, 2) '품명
.Offset(i) = rngCell.Offset(, 5 + colorI) & rngCell.Offset(, 6 + cntColor + sizeI) '규격
.Offset(i, 1) = rngCell.Offset(, 3) & " " & .Offset(i) '물품별칭
.Offset(i, 4) = rngCell.Offset(, 4) '주매입처
.Offset(i, 5) = rngCell.Offset(, 8 + cntColor + cntSize) '매입단가
.Offset(i, 6) = rngCell.Offset(, 9 + cntColor + cntSize) '판매단가
.Offset(i, 18) = "http://gi.esmplus.com/conan85/sol/pre/" & rngCell.Offset(, 7 + cntColor + cntSize) & ".jpg"
End With
i = i + 1
Next sizeI
Next colorI
'텍스트 나누기 된 임시셀 지우기
.Offset(, 5).Offset(, 1).Resize(, cntColor).Delete shift:=xlToLeft
.Offset(, 6).Offset(, 1).Resize(, cntSize).Delete shift:=xlToLeft
End With
Next rngCell
'공통값 입력
With rngImport
i = .End(xlDown).Row - 1
.Offset(, -4).Resize(i) = "신발" '신발
.Offset(, 2).Resize(i) = "EA" '단위
.Offset(, 3).Resize(i) = 500
.Offset(, 3).Resize(i).NumberFormatLocal = "0.00_ " '무게
.Offset(, 7).Resize(i, 6) = 0 '소비자가, 과세여부, 입수량, 양품재고, 불량재고, 재고관리
.Offset(, 13).Resize(i) = "정상" '판매상태
End With
'변환1 시트 열,행 맞춤
Application.GoTo wS1.Range("A1")
With Range("A1").CurrentRegion
.Columns.AutoFit
.Rows.AutoFit
End With
'처리속도 복구
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Sub fnChange2()
Dim rngArea As Range, rngCell As Range
Dim rngImport As Range
Dim cntColor As Integer, colorI As Integer
Dim wsGoods As Worksheet, wS2 As Worksheet
Dim i As Integer
Dim rngWs2 As Range
Dim 초성 As Variant, vR() As Variant
Dim n As Long, k1 As Integer
Dim strKor As String
'처리속도 향상
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'워크시트 정의
Set wsGoods = Sheets("상품정리")
Set wS2 = Sheets("변환2")
'기존자료 삭제
i = wS2.Range("A1").CurrentRegion.Rows.Count
If i > 8 Then
wS2.Range("A1").Offset(8).Resize(i - 1).EntireRow.ClearContents
End If
i = 0
'상품 분류 중 빈셀을 제외한 셀영역 및 변환2 상품명 셀 작업기준
wsGoods.Select
If Range("E3") = "" Then
Set rngArea = wsGoods.Range("E2")
Else
Set rngArea = wsGoods.Range("E2", Cells(Rows.Count, "E").End(xlUp)).SpecialCells(2)
End If
Set rngImport = wS2.Cells(Rows.Count, "C").End(xlUp).Offset(1)
For Each rngCell In rngArea
With rngCell
'색상을 콤마 기준으로 텍스트 나누기
Application.DisplayAlerts = False
On Error Resume Next '색상이 없을 때 오류 발생
With .Offset(, 5)
cntColor = Len(.Value) - Len(Replace(.Value, ",", "")) + 1
.Offset(, 1).Resize(, cntColor).Insert shift:=xlToRight
.Cells.TextToColumns Destination:=.Offset(, 1), Comma:=True
End With
On Error GoTo 0
Application.DisplayAlerts = True
End With
'색상별 품명, 색상, 추가금액, 상품명 첫글자 가져오기
For colorI = 1 To cntColor
With rngImport
.Offset(i) = rngCell.Offset(, 2) '상품명
.Offset(i, 1) = rngCell.Offset(, 5 + colorI) '색상
.Offset(i, 2) = rngCell.Offset(, 9 + cntColor) '추가금액
'상품명의 첫자음이 한글일 때
If Mid(rngCell.Offset(, 2), 1, 1) Like "[가-힇]" Then
초성 = Array("ㄱ", "ㄲ", "ㄴ", "ㄷ", "ㄸ", "ㄹ", "ㅁ", "ㅂ", "ㅃ", "ㅅ", "ㅆ", "ㅇ", "ㅈ", "ㅉ", "ㅊ", "ㅋ", "ㅌ", "ㅍ", "ㅎ")
n = AscW(Mid(rngCell.Offset(, 2), 1, 1)) + 21504
k1 = Int(n / (21 * 28))
ReDim vR(0)
'된발음일 때 평음으로 변환
Select Case 초성(k1)
Case "ㄲ": 초성(k1) = "ㄱ"
Case "ㄸ": 초성(k1) = "ㄷ"
Case "ㅃ": 초성(k1) = "ㅂ"
Case "ㅆ": 초성(k1) = "ㅅ"
Case "ㅉ": 초성(k1) = "ㅈ"
End Select
vR(0) = 초성(k1) & "."
.Offset(i, -1) = vR(0)
'상품명의 첫자음이 알파벳일 때
ElseIf Mid(rngCell.Offset(, 2), 1, 1) Like "[A-Z]" Then
Select Case Mid(rngCell.Offset(, 2), 1, 1)
Case "A", "E", "I", "M", "O", "U", "X", "W", "Y": strKor = "ㅇ"
Case "B", "V": strKor = "ㅂ"
Case "C", "S": strKor = "ㅅ"
Case "D": strKor = "ㄷ"
Case "F", "P": strKor = "ㅍ"
Case "G", "J", "Z": strKor = "ㅈ"
Case "H": strKor = "ㅎ"
Case "K", "Q": strKor = "ㅋ"
Case "L", "R": strKor = "ㄹ"
Case "N": strKor = "ㄴ"
Case "T": strKor = "ㅌ"
End Select
.Offset(i, -1) = strKor & "."
End If
End With
i = i + 1
Next colorI
'텍스트 나누기 된 임시셀 지우기
rngCell.Offset(, 5).Offset(, 1).Resize(, cntColor).Delete shift:=xlToLeft
Next rngCell
wS2.Select
'공통값 입력
With rngImport
i = .CurrentRegion.Rows.Count - 8
.Offset(, -2).Resize(i) = "3S" '선택정보타입
.Offset(, 3).Resize(i) = 0 '재고수량
.Offset(, 4).Resize(i) = "정상" '상태
.Offset(, 5).Resize(i) = "Y" '노출여부
.Offset(, 7).Resize(i, 2) = "0,0,0" '추천옵션 코드
End With
'상품명을 기준으로 오름차순 정렬
Set rngWs2 = Range(Range("A9"), Cells(Rows.Count, "K").End(xlUp))
rngWs2.Sort key1:=Range("B9"), order1:=xlAscending, key2:=Range("C9"), order2:=xlAscending
'변환2 시트 열,행 맞춤
With Range("A1").CurrentRegion
.Columns.AutoFit
.Rows.AutoFit
End With
'처리속도 복구
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Sub fnChange3()
Dim rngArea As Range, rngCell As Range
Dim rngImport As Range
Dim wsGoods As Worksheet, wS3 As Worksheet
Dim strCode As Integer
Dim i As Integer
Dim rpColor As String, rpSize As String
Const strExpln As String = "<center><img src=" & """" & "http://gi.esmplus.com/conan85/sol/body/"
Const strExplnJpg As String = ".jpg""></center>"
Const strImg600 As String = "http://gi.esmplus.com/conan85/sol/600/"
Const strImgTiny As String = "http://conan0.cafe24.com/web/product/tiny/"
Const strImg300 As String = "http://gi.esmplus.com/conan85/sol/300/"
Const strJpg As String = ".jpg"
'처리속도 향상
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'워크시트 정의
Set wsGoods = Sheets("상품정리")
Set wS3 = Sheets("변환3")
'기존자료 삭제
i = wS3.Range("A1").CurrentRegion.Rows.Count
If i > 1 Then
wS3.Range("A1").Offset(1).Resize(i - 1).EntireRow.ClearContents
End If
i = 0
'상품 분류 중 빈셀을 제외한 셀영역 및 변환3 상품분류번호 셀 작업기준
wsGoods.Select
If Range("E3") = "" Then
Set rngArea = wsGoods.Range("E2")
Else
Set rngArea = wsGoods.Range("E2", Cells(Rows.Count, "E").End(xlUp)).SpecialCells(2)
End If
wS3.Select
Set rngImport = wS3.Cells(Rows.Count, "E").End(xlUp).Offset(1)
'상품분류 영역에서 아래로 내려가며 작업 시작
For Each rngCell In rngArea
'상품분류번호 설정
With rngCell
Select Case .Value
Case "운동화": strCode = 7
Case "여아구두": strCode = 4
Case "로퍼": strCode = 12
Case "샌들", "아쿠아": strCode = 24
Case "부츠", "레인부츠": strCode = 26
Case "가방", "악세사리": strCode = 28
Case "여성": strCode = 30
End Select
End With
'변환3 값 넣기
With rngImport
.Offset(i) = strCode '상품분류번호
.Offset(i, 3) = rngCell.Offset(, 2) '상품명
.Offset(i, 9) = strExpln & rngCell.Offset(, 7) & strExplnJpg '상품 상세설명
.Offset(i, 13) = rngCell.Offset(, 8) '공급가
.Offset(i, 14) = rngCell.Offset(, 9) '판매가
.Offset(i, 31).Resize(, 2) = strImg600 & rngCell.Offset(, 7) & strJpg '이미지등록(상세), 이미지등록(목록)
.Offset(i, 33) = strImgTiny & rngCell.Offset(, 7) & strJpg '이미지등록(작은목록)
.Offset(i, 34) = strImg300 & rngCell.Offset(, 7) & strJpg '이미지등록(축소)
'색상, 사이즈 변환
rpColor = Replace(rngCell.Offset(, 5), ",", "|")
rpSize = Replace(rngCell.Offset(, 6), ",", "|")
.Offset(i, 25) = "색상{" & rpColor & "}//사이즈{" & rpSize & "}" '옵션입력
End With
i = i + 1
Next rngCell
'공통값 입력
With rngImport
i = .CurrentRegion.Rows.Count - 1
.Offset(, -2).Resize(i, 2) = "Y" '진열상태, 판매상태
.Offset(, 1).Resize(i, 2) = "N" '상품분류 신상품영역, 상품분류 추천상품영역
.Offset(, 11).Resize(i) = "A|10" '과세구분
.Offset(, 12).Resize(i) = 0 '소비자가
.Offset(, 15).Resize(i) = "N" '판매가 대체문구 사용
.Offset(, 17).Resize(i) = 1 '최소 주문수량(이상)
.Offset(, 19).Resize(i) = 1 '적립금
.Offset(, 20).Resize(i) = "P" '적립금 구분
.Offset(, 21).Resize(i) = "N" '성인인증
.Offset(, 22).Resize(i) = "Y" '옵션사용
.Offset(, 23).Resize(i) = "T" '품목 구성방식
.Offset(, 24).Resize(i) = "S" '옵션 표시방식
.Offset(, 26).Resize(i) = "FIF" '필수여부
.Offset(, 27).Resize(i) = "F" '추가입력옵션
.Offset(, 41).Resize(i) = "F" '유효기간 사용여부
.Offset(, 42).Resize(i) = "--~--" '유효기간
.Offset(, 43).Resize(i) = 1800 '원산지
.Offset(, 44).Resize(i) = "고액결제의 경우 안전을 위해 카드사에서 확인전화를 드릴 수도 있습니다." & _
"확인과정에서 도난 카드의 사용이나 타인 명의의 주문등 정상적인 주문이 아니라고 판단될 경우 임의로 주문을 보류 또는 취소할 수 있습니다. " & _
"<br><br> 무통장 입금은 상품 구매 대금은 PC뱅킹, 인터넷뱅킹, 텔레뱅킹 혹은 가까운 은행에서 직접 입금하시면 됩니다. <br> " & _
"주문시 입력한 입금자명과 실제입금자의 성명이 반드시 일치하여야 하며, 7일 이내로 입금을 하셔야 하며 입금되지 않은 주문은 자동취소 됩니다. <br>" '상품결제안내
.Offset(, 45).Resize(i) = "- 산간벽지나 도서지방은 별도의 추가금액을 지불하셔야 하는 경우가 있습니다.<br> 고객님께서 주문하신 상품은 입금 확인후 배송해 드립니다. " & _
"다만, 상품종류에 따라서 상품의 배송이 다소 지연될 수 있습니다.<br>" '상품배송안내
.Offset(, 46).Resize(i) = "<b>교환 및 반품이 가능한 경우</b><br> - 상품을 공급 받으신 날로부터 7일이내 단, 가전제품의<br> 경우 포장을 개봉하였거나 " & _
"포장이 훼손되어 상품가치가 상실된 경우에는 교환/반품이 불가능합니다.<br>- 공급받으신 상품 및 용역의 내용이 표시.광고 내용과<br>" & _
" 다르거나 다르게 이행된 경우에는 공급받은 날로부터 3월이내, 그사실을 알게 된 날로부터 30일이내<br><br><b>교환 및 반품이 불가능한 경우</b><br>" & _
"- 고객님의 책임 있는 사유로 상품등이 멸실 또는 훼손된 경우. 단, 상품의 내용을 확인하기 위하여<br> 포장 등을 훼손한 경우는 제외<br>" & _
"- 포장을 개봉하였거나 포장이 훼손되어 상품가치가 상실된 경우<br> (예 : 가전제품, 식품, 음반 등, " & _
"단 액정화면이 부착된 노트북, LCD모니터, 디지털 카메라 등의 불량화소에<br> 따른 반품/교환은 제조사 기준에 따릅니다.)<br>" & _
"- 고객님의 사용 또는 일부 소비에 의하여 상품의 가치가 현저히 감소한 경우 단, 화장품등의 경우 시용제품을 <br> 제공한 경우에 한 합니다.<br>" & _
"- 시간의 경과에 의하여 재판매가 곤란할 정도로 상품등의 가치가 현저히 감소한 경우<br>- 복제가 가능한 상품등의 포장을 훼손한 경우<br>" & _
" (자세한 내용은 고객만족센터 1:1 E-MAIL상담을 이용해 주시기 바랍니다.)<br><br>" & _
"※ 고객님의 마음이 바뀌어 교환, 반품을 하실 경우 상품반송 비용은 고객님께서 부담하셔야 합니다.<br> (색상 교환, 사이즈 교환 등 포함)<br>" '교환/반품안내
.Offset(, 47).Resize(i) = "." '서비스문의/안내
.Offset(, 48).Resize(i) = "F" '배송정보
.Offset(, 53).Resize(i) = "3|7" '배송기간
.Offset(, 56).Resize(i) = 1 '상품 전체중량(kg)
End With
'처리속도 복구
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Sub fnChange4()
Dim rngArea As Range, rngCell As Range
Dim wS1 As Worksheet, wS4 As Worksheet
'처리속도 향상
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'시트명 정의
Set wS1 = Sheets("변환1")
Set wS4 = Sheets("변환4")
'기존자료 삭제
wS4.Columns("A:D").ClearContents
'변환1에서 상품명, 규격, 가격 복사하고 제목셀 입력
wS1.Columns("D:E").Copy wS4.Range("A1")
wS1.Columns("K").Copy wS4.Range("D1")
wS4.Range("A1:D1") = Array("상품명", "색상", "사이즈", "가격")
wS4.Select
'색상과 사이즈 분할
Set rngArea = Range("B2", Cells(Rows.Count, "B").End(xlUp))
For Each rngCell In rngArea
With rngCell
.Offset(, 1) = Right(.Value, 3) '사이즈
.Cells = Left(.Cells, Len(.Cells) - 3)
End With
Next rngCell
'처리속도 복구
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
정리(변환1,2,3,4_완료).xlsm
'VB(A)' 카테고리의 다른 글
| 다른 셀로 하이퍼링크 설정 (0) | 2015.03.05 |
|---|---|
| 부부직원이면 빨간색으로 표시하기 (0) | 2015.03.01 |
| 폴더 선택하여 텍스트파일 한줄로 가져오기 (0) | 2015.02.25 |
| 일부 시트들을 새 파일로 저장 (0) | 2015.02.23 |
| 이름을 자음 모음으로 분리하기 (0) | 2015.02.22 |