VB(A)

Select Case 를 활용한 다중 조건 처리

당근쨈 2015. 1. 28. 15:09

엑셀마스터에 올라온 질문 글.

상품 및 개수의 셀을 보면 한 셀에 품목이 두개 이상 입력된 것도 있고

품목과 주문 개수가 한 셀에 있어 이것을 분리하고 싶다는 내용의 질문이다.


품목을 보면 '/'를 기준으로 나뉘어져있어서 텍스트 나누기를 통해 셀을 나누고

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

+ 매크로 실행 전 +

+ 매크로 실행 후 +

거래처 발주현황 150112.xlsm



'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