엑셀마스터에 올라온 질문 글.
상품 및 개수의 셀을 보면 한 셀에 품목이 두개 이상 입력된 것도 있고
품목과 주문 개수가 한 셀에 있어 이것을 분리하고 싶다는 내용의 질문이다.
품목을 보면 '/'를 기준으로 나뉘어져있어서 텍스트 나누기를 통해 셀을 나누고
Select Case 구문과 품목별 원문자를 이용하여 제품별로 글자개수를 파악하여 품목과 주문개수를 나누었다.
작업을 할 수록 느끼지만, 코드를 짜는 것은 코딩 능력과 동시에 문제를 해결해나가는 요령이 많이 필요하다.
상품 개수를 파악할 때 instr 함수를 이용하여 숫자만 빼려고 했는데 알 수 없는 에러에 봉착하여
하는 수 없이 작업이 완료된 후에 replace 함수를 이용하여 "개"를 빼도록 했다.
왜 에러가 나는지 도무지 모르겠네.
처음 만든 결과물이 생각대로 안 나온 탓인지 세번 정도 수정한 케이스.
의뢰 아닌 의뢰인의 입맛에 맞도록 하는 것이 관건.
수요자의 의도를 제대로 파악하는 것이 공급자의 역할 아니겠는가.
수정할 것이 있을 수록 내가 공부할 수 있는 기회가 많아진다는 뜻.
Sub deVide()
Dim i As Integer, j As Integer, x As Integer
Dim strCell As Range, rngAll As Range
'경고메시지 및 업데이트 끄기
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'작업을 위한 임시 열 생성
Columns("L:O").Select
Selection.Insert Shift:=xlToRight
'상품셀을 기준으로 작업 시작
Set strCell = Range("L1")
'K열의 내용을 L열로 복사
Columns("K").SpecialCells(2).Copy
strCell.Select
ActiveSheet.Paste
'상품을 / 기준으로 분리
Columns("L").SpecialCells(2).Select
Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
'N열 각 셀의 띄어쓰기 되어있는 것 삭제
With strCell
i = 1
Do While .Offset(i, 0) <> ""
.Offset(i, 2) = Trim(.Offset(i, 1))
.Offset(i, 1).ClearContents
i = i + 1
Loop
'L,N열의 상품정보의 번호를 기준으로 글자 개수 파악하여 상품명과 주문개수 분리
For i = 12 To 14 Step 2
For x = 2 To .CurrentRegion.Rows.Count
Select Case Left(Cells(x, i), 1)
Case "①": j = 12
Case "②": j = 14
Case "③": j = 9
Case "④": j = 8
Case "⑤": j = 8
Case "⑥": j = 8
Case "⑦": j = 7
Case "⑧": j = 14
End Select
Cells(x, i + 1) = Mid(Cells(x, i), j + 2, 20)
Cells(x, i) = Mid(Cells(x, i), 3, j - 2)
Next x
Next i
End With
'상품 개수에 있는 "개"를 삭제
Set rngAll = Columns("M").SpecialCells(2)
rngAll.Replace what:="개", replacement:=""
Set rngAll = Columns("O").SpecialCells(2)
rngAll.Replace what:="개", replacement:=""
'K~O열 열너비 자동맞춤
Columns("K:O").Select
Selection.Columns.AutoFit
strCell.ClearContents
strCell.Select
'경고메시지 켜기
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
+ 매크로 실행 전 +
+ 매크로 실행 후 +
'VB(A)' 카테고리의 다른 글
일정 간격으로 내용 복사 (0) | 2015.02.03 |
---|---|
Private Sub Worksheet_Change(ByVal Target As Range) (0) | 2015.01.30 |
자동채우기 (0) | 2015.01.18 |
내 맘대로 의뢰받은 척 하고 만듬 (0) | 2015.01.15 |
의뢰받아 만든 발주서 (0) | 2015.01.14 |