연속된 숫자는 ~로 표현하기

한 셀에 1,2,3,6,7,9 라는 숫자가 있으면

1~3,6~7,9 로 표현하는 매크로다.

버튼식 매크로와 사용자정의함수로 만들었다.

버튼식을 만들면 함수는 버튼식에서 변경만 하면 되니까.

동일한 수식이 여러개 들어가고 배열을 막 붙였다. 더 깔끔한 코드가 있을 것 같은데...

다음은 작업 일지.

1. 셀의 숫자를 콤마 기준으로 나눈다.

2. 연속된 숫자인지 판단하여 ~로 묶어줌

Sub Macro()
 
    Dim rngData As Range, rngcell As Range
    Dim arrNum As Variant
    Dim i As Integer, j As Integer, k As Integer
    Dim ValArr() As Integer
    Dim strText() As String
    
    '숫자영역 설정 및 기존자료 삭제
    Set rngData = Range("A1", Cells(Rows.Count, "A").End(xlUp))
    rngData.Offset(, 1).ClearContents
    
    For Each rngcell In rngData
        
        '콤마를 기준으로 숫자 나눔
        arrNum = Split(rngcell, ",")
        
        For i = 0 To UBound(arrNum)
            On Error Resume Next
            
                '연속된 숫자일 때 재배열
                If Val(arrNum(i + 1)) = Val(arrNum(i)) + 1 Then
                    If Err.Number = 0 Then
                        ReDim Preserve ValArr(j)
                        ValArr(j) = arrNum(i)
                        j = j + 1
                        
                    '배열의 끝일 때
                    Else
                        ReDim Preserve ValArr(j)
                        ValArr(j) = arrNum(i)
                        ReDim Preserve strText(k)
                        
                        '앞뒤로 연속된 숫자가 아닐 땐 ~ 안 붙임
                        If IsEmpty(ValArr(1)) Then
                            strText(k) = ValArr(0)
                        Else
                            strText(k) = ValArr(0) & "~" & ValArr(j)
                        End If
                        k = 0
                        j = 0
                    End If
                On Error GoTo 0
                
                '연속되지 않은 숫자일 때 ~ 로 묶음
                Else
                    ReDim Preserve ValArr(j)
                    ValArr(j) = arrNum(i)
                    ReDim Preserve strText(k)
                    
                    '앞뒤로 연속된 숫자가 아닐 땐 ~ 안 붙임
                    If IsEmpty(ValArr(1)) Then
                        strText(k) = ValArr(0)
                    Else
                        strText(k) = ValArr(0) & "~" & ValArr(j)
                    End If
                    k = k + 1
                    j = 0
                End If
        Next i
        
    k = 0
    rngcell.Offset(, 1) = Join(strText, ",")
    Next rngcell
    
End Sub

Book1.xlsm