連続番号を範囲に置き換えます。

Question

セル内で連続番号を見つけて範囲に置き換えるにはどうすればよいですか？たとえば
：

変更：

1,3,5,15,16,17,25,28,29,31 ...

へ：

1,3,5,15-17,25,28-29,31 ...

数値はすでにソートされています（つまり、昇順にソートされています）。

ありがとうございました。

Answer 1

私はシーケンシャルのチェック（最初のソート必要になる）シーケンスをループしなくてはなら見てみたかった興味深い質問は

1. が範囲アドレス
に文字列を強制的にこの機能を構築します
2. 列識別子

を除去するために、文字列を操作

一緒にグループ連続行にUnionを使用します

ループは、短いバージョン必要はありませんでした！

Function NumOut(strIn As String) As String 
Dim rng1 As Range 
Set rng1 = Range("A" & Join(Split(Application.Trim([a1]), ", "), ",A")) 
'force the range into areas rather than cells 
Set rng1 = Union(rng1, rng1) 
NumOut = Replace(Replace(Replace(rng1.Address, "$A$", vbNullstring), ": ", "-"), ",", ", ") 
End Function 

Answer 2

与えられた範囲/面積ベースの答えは興味深いですが、それは欠陥のカップルに苦しんでいる：

• 比較的遅い255文字
• の入力文字列に制限されています

基本的なアレイループベースの方法です。それは長い文字列を扱うことができます。私のテストでは約1/3の時間で実行されます。また、入力をソートする必要がないという特典もあります。

Function NumOut2(strIn As String) As String 
    Dim arrIn() As String 
    Dim arrBuckets() As Long 
    Dim i As Long 
    Dim InRange As Boolean 
    Dim mn As Long, mx As Long 

    arrIn = Split(strIn, ", ") 
    mn = arrIn(0) 
    mx = arrIn(0) 
    For i = 1 To UBound(arrIn) 
     If arrIn(i) < mn Then 
      mn = arrIn(i) 
     ElseIf arrIn(i) > mx Then 
      mx = arrIn(i) 
     End If 
    Next 

    ReDim arrBuckets(mn To mx) 
    For i = 0 To UBound(arrIn) 
     arrBuckets(arrIn(i)) = arrIn(i) 
    Next 
    NumOut2 = LBound(arrBuckets) 
    InRange = False 
    For i = LBound(arrBuckets) + 1 To UBound(arrBuckets) 
     If arrBuckets(i) > 0 Then 
      If arrBuckets(i) = arrBuckets(i - 1) + 1 Then 
       If InRange Then 

       Else 
        InRange = True 
        NumOut2 = NumOut2 & "-" 
       End If 
      Else 
       If InRange Then 
        NumOut2 = NumOut2 & arrBuckets(i - 1) & ", " & arrBuckets(i) 
       Else 
        NumOut2 = NumOut2 & ", " & arrBuckets(i) 
       End If 
      End If 
     Else 
      If InRange Then 
       NumOut2 = NumOut2 & arrBuckets(i - 1) 
      End If 
      InRange = False 
     End If 
    Next 

End Function