Excelにて連続する数値の省略表現を行いたい

Question

Excelにて、連続する数値の省略表現を行いたいです。
以下が、例です。

1
2
3
5
7
8

などの整数値が改行区切りでセルに入っています。
これを、

1―3
5
7―8

と表現したいです。
また、数値に関してはスタートは1とは限らず、また数値、データ数も日により異なります。

私なりに調べてみたものの、そもそも何というワードで検索を行うのが適切かがまずわからず、手詰まりの状態となってしまっております。

やり方に関してはExcelの関数、VBA問わず、実行環境はExcel2016です。

どなたか、ご教授いただけると幸いです。

Answer 1

Sub Syouryaku1()
    Dim ws As Worksheet, arr, result, i
    Set ws = Worksheets.Add
    With ws.Range("A1")
        .Value = Join(Array(1, 2, 3, 7), vbLf)
        
        MsgBox .Value
        
        arr = Split(.Value, vbLf)
        result = Join(ry(arr), ",")
        .Offset(0, 2).Value = result
        
        For i = 1 To Len(result)
            .Offset(1, 1 + i).Value = Mid(result, i, 1)
        Next
    End With
End Sub
Sub Syouryaku2()
    Dim ws As Worksheet, arr, result, i
    Set ws = Worksheets.Add
    With ws.Range("A1")
        .Offset(0).Value = "1"
        .Offset(1).Value = "2"
        .Offset(2).Value = "3"
        .Offset(3).Value = "7"
        
        arr = RangeToArray(.CurrentRegion)
        
        MsgBox Join(arr, vbLf)
        
        result = Join(ry(arr), ",")
        .Offset(0, 2).Value = result
        
        For i = 1 To Len(result)
            .Offset(1, 1 + i).Value = Mid(result, i, 1)
        Next
    End With
End Sub

Sub Syouryaku3()
    Dim ws As Worksheet, arr, result, i
    Set ws = Worksheets.Add
    With ws.Range("A1")
        .Offset(, 0).Value = "1"
        .Offset(, 1).Value = "2"
        .Offset(, 2).Value = "3"
        .Offset(, 3).Value = "7"
        
        arr = RangeToArray(.CurrentRegion)
        
        MsgBox Join(arr, " ")
        
        result = Join(ry(arr), ",")
        .Offset(2).Value = result
        
        For i = 1 To Len(result)
            .Offset(3, i - 1).Value = Mid(result, i, 1)
        Next
    End With
End Sub
Function RangeToArray(rng As Range) As Variant()
    ReDim arr(rng.Cells.Count - 1)
    Dim c As Range, i
    For Each c In rng
        arr(i) = c.Value
        i = i + 1
    Next
    RangeToArray = arr
End Function
Function ry(a)
    Dim d, k, i
    Set d = CreateObject("Scripting.Dictionary")
    k = a(0)
    d(k) = 0
    For i = 1 To UBound(a)
        If a(i) - a(i - 1) = 1 Then
            d(k) = d(k) + 1
        Else
            k = a(i)
            d(k) = 0
        End If
    Next
    For Each k In d
        d(k) = IIf(d(k) = 0, k, k & "-" & k + d(k))
    Next
    ry = d.Items
End Function

Answer 2

力技ですが、与えられたセルの文字列をあなたが期待する形式に変換する関数:Henkanを作成しました。
変換試験でHenkanを呼び出しています。（Ａ列が変換前、Ｂ列が変換後です）
セル内の改行コードはvblfの前提です。
改行コードがvblfでない場合、もしくは、データが数字でない場合は、変換は行われません。

Option Explicit

Public Function Henkan(ByVal str As String) As String
    Henkan = str
    Dim arr As Variant
    Dim num_s As Variant
    Dim num_e As Variant
    Dim ostr() As String
    Dim ox As Long
    Dim i As Long
    ox = -1
    arr = Split(str, vbLf)
    If UBound(arr) = 0 Then Exit Function
    For i = 0 To UBound(arr)
        If IsNumeric(arr(i)) = False Then Exit Function
        If i = 0 Then
            num_s = arr(i)
            num_e = arr(i)
        Else
            If CLng(num_e) + 1 = CLng(arr(i)) Then
                num_e = arr(i)
            Else
                ox = ox + 1
                ReDim Preserve ostr(ox)
                If num_s = num_e Then
                    ostr(ox) = num_s
                Else
                    ostr(ox) = num_s & "-" & num_e
                End If
                num_s = arr(i)
                num_e = arr(i)
            End If
        End If
    Next
    ox = ox + 1
    ReDim Preserve ostr(ox)
    If CLng(num_e) = CLng(num_s) Then
        ostr(ox) = num_s
    Else
        ostr(ox) = num_s & "-" & num_e
    End If
    Henkan = Join(ostr, vbLf)
End Function

Public Sub 変換試験()
    Dim wrow As Long
    For wrow = 1 To 10
        Cells(wrow, 2).Value = Henkan(Cells(wrow, 1).Value)
    Next
End Sub

実行結果

Comments

[nna1016]

ご回答、ありがとうございます。

どうすればよいのかわからず、行き詰まっていたところ自らがやりたかったことにマッチした回答をいただきとても驚いております。

例えばなのですが、数字がセルに分かれて入っていた場合は、上記作成していただけたコードのどの部分に変更を加えると実現できるでしょうか。
以下、例です。

1
＿
2
＿
3
＿
7

実行結果
1～3,7

また、この結果を文字ごとに分割したい場合可能でしょうか。
以下、例です。

　｜A｜B｜C｜D｜E｜
1 ｜1｜～｜4｜, |7 ｜

ご回答していただいた上、さらなる質問となってしまい大変申し訳無いのですがご教授いただけると幸いです。

[tatsu99]

1
＿
2
＿
3
＿
7
の意味はセルで表すと
A1=1
A2=2
A3=3
A4=7
という意味ですか。連続するのが縦という前提ですか。横のケースもあるのですか。
いずれにしろ、考え方は同じなのでが、手を加える個所がかなり違ってきます。
作り直した方が良いでしょう。
その場合は、変更前の具体的なセルの位置、変更後の文字を格納したいセルの位置、変更後の文字を文字ごとに分割して格納したいセルの位置をきちんと提示してください。できれば画像の方が良いです。

[tatsu99]

画像をアップされる場合は、アクセサリのsnipping toolを使うと、簡単に画像が切り取れます。
解凍の画像もsnipping toolを使っています。

Answer 3

vbaなら全てのデータをforループで地道にif文比較していくのが簡単そうです。

追記
改行区切りの意味を理解してませんでした。
Replace関数やReplaceメソッドで対応できそうですかね
Replace

Replace関数では、画面に表示される文字列だけでなく、改行コードやタブコードなどの制御コードも置換できます。

テキストファイルなどで使われている、一般的な改行コードはvbCrLfですが、Excelのセル内改行では、vbLfが使われています。定数については、下記のページをご覧ください。

また作業名としてはデータクレンジング、データスクラビングとかデータクリーニングが近いのでしょうか。
データクレンジングと名寄せ