숫자만 인식하기

빈셀이 많아서 의외로 까다로웠던 경우.

resize(3,0) 이 아니라 resize(3,1) 처럼 Resize는 1이 기본값이라는 걸 뼈저리게 느꼈고

빈셀에 문자를 넣은 후 Like "[0-9]" 를 이용하여 숫자만 인식하도록 잔머리를 굴렸다.

Option Explicit

Sub 매크로1()

    Dim rngCopy As Range

    Dim rngStart As Range

    Dim rngCell As Range

    Dim rngArea As Range

    Dim intR As Integer

    Dim i As Integer, j As Integer

    Dim cntCell As Integer

    

    '기준셀, 작업시작셀, 열 수 정의

    Set rngCopy = Range("C2")

    Set rngStart = Range("J1")

    intR = rngCopy.CurrentRegion.Rows.Count - 1

    Set rngArea = Range(rngCopy, Cells(intR + 1, "G"))

    

    '기존자료 삭제

    rngStart.CurrentRegion.Clear

    

    '일련번호를 셀 개수만큼 복사하기

    i = 1

    For Each rngCell In rngCopy.Offset(, -2).CurrentRegion

        cntCell = rngArea.Rows(i).SpecialCells(2).Count

        Cells(Rows.Count, "J").End(xlUp).Offset(1, 0).Resize(cntCell, 1) = rngCell

        i = i + 1

    Next rngCell

    

    '셀 내용 복사하고 번호 가져오기

    i = 1

    rngArea.SpecialCells(4) = "T"

    

    For Each rngCell In rngArea

        

        Select Case rngCell.End(xlUp)

            Case Is = 1: j = 220

            Case Is = 2: j = 230

            Case Is = 3: j = 240

            Case Is = 4: j = 250

            Case Is = 5: j = 260

        End Select

        

        If rngCell Like "[0-9]" Then

            rngStart.Offset(i, 1) = j

            rngStart.Offset(i, 2) = rngCell

        End If

        

        i = i + 1

    Next rngCell

    

    '임시로 넣은 문자 지우기

    rngArea.Replace What:="T", Replacement:=""

    

    '빈셀 지우기

    rngStart.CurrentRegion.SpecialCells(4).Delete

        

End Sub

Book1.xlsm