Question

VBA怎么将连续数字变成带“-”表示，如有一组数据：1，2，3，5，6，7，9，11，12变成1-3，5-7，9，11-12.

VBA或VBS 怎么将连续的数字变成带“-”表示，如有一组数据：1，2，3，5，6，7，9，11，12变成1-3，5-7，9，11-12.。意思是：在这组数据中1，2，3是连续的数据他会变成1-3来表示（但有些数据是不连续的，我只想把连续的数以“-”表示，而其他不连续的以单个数显示），用VBS或VBA怎么编啊？？？跪求大神。

Answer 1

Sub 连续数字组合()
  arr = Array(1, 2, 3, 5, 6, 7, 9, 11, 12, 1000)
  '为防止下标超出数组尾多加一个数，该数不参加整理
  '实际操作中该数由程序加入，不影响原数据规则
  a = arr(0)
  For i = 1 To 8
    If arr(i) - arr(i - 1) > 1 Then
      a = a & "," & arr(i)
    ElseIf arr(i + 1) - arr(i) > 1 Then
      a = a & "-" & arr(i)
    End If
  Next i
  MsgBox "整理前数字：1, 2, 3, 5, 6, 7, 9, 11, 12" & _
         vbNewLine & "整理后数字：" & a
End Sub

Answer 2

 Private Sub Form11_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim count As Boolean = True '判断是否连续的变量
        Dim Str As String = String.Empty
        Dim r As Integer = 0
        Dim a(10) As Integer
        a(0) = 1
        a(1) = 2
        a(2) = 3
        a(3) = 5
        a(4) = 6
        a(5) = 7
        a(6) = 9
        a(7) = 11
        a(8) = 12
        a(9) = 13
        a(10) = 15
        r = a(0)
        For i = 1 To a.Length - 1
            If a(i) - 1 = a(i - 1) Then
                If i = a.Length - 1 Then
                    Str = Str & r & "-" & a(i)
                End If
                count = True
            Else
                If i = a.Length - 1 Then
                    Str = Str & r & "-" & a(i - 1) & ","
                    Str = Str & a(i)
                Else
                    If count Then
                        Str = Str & r & "-" & a(i - 1) & ","
                    Else
                        Str = Str & r & ","
                    End If
                End If
                r = a(i)
                count = False
            End If
        Next
        MsgBox(Str)
        Me.Close()
    End Sub

首先,我这个因为是用vb.net写的,所以我不知道你放在VBA里面会不会有问题,但是我这边测试过了,逻辑上没有问题了,而且数组里面的数字我各种的都试过,应该没有问题了,不过有一点,这个只能用在升序上,如果里面出现了9,8,7,会被认为不连续的

希望能够帮上忙...

Answer 3

Sub t()
Dim str As String, tmp, arr, res As String
str = "1，2，3，5，6，7，9，11，12"
arr = Split(str, "，")
For i = 0 To UBound(arr) - 1
    k = i: m = 0
    Do
        If arr(i + 1) * 1 = arr(i) * 1 + 1 Then
            i = i + 1: m = m + 1
            If i = UBound(arr) Then
                res = res & "，" & arr(k) & "-" & arr(i)
                Exit Do
            End If
        Else
            If m <> 0 Then
                res = res & "，" & arr(k) & "-" & arr(i)
            Else
                res = res & "，" & arr(k)
            End If
            Exit Do
        End If
    Loop
Next
res = Mid(res, 2)
MsgBox res
End Sub

Answer 4

Sub df()
arr = Array(1, 2, 3, 5, 6, 7, 9, 11, 12)
m = Application.Min(arr) '最小
m2 = Application.Max(arr) '最大
On Error Resume Next '错继续
Set d = CreateObject("scripting.dictionary") '创建对象
ReDim brr(m2)
For i = 0 To UBound(arr)
d.Add arr(i), 1
Next
n = n + 1
If d.Exists(m + 1) = True Then
For i = m To m2
If d.Exists(i + 1) = True Then
brr(n - 1) = m & "-" & i + 1
Else
n = n + 1
m = i + 2
End If
Next
Else
brr(n - 1) = m
For i = m To m2
If d.Exists(i + 1) = False Then
n = n + 1
m = i + 2
Else
brr(n - 1) = m & "-" & i + 1
End If
Next
End If
Cells(1, 1).Resize(n + 1, 1) = Application.Transpose(brr)
End Sub