Question

给出一系列数字：

[1,3,4,5,8,9,11]

VBA中将该列表转换为可读字符串的最简单方法是什么，例如：

1,3-5,8-9,11

我可以将我的VB.net功能重写为VBA，但它已经很长时间了，在VBA中它会更长。

Public Shared Function GroupedNumbers(nums As List(Of Long))

    If nums Is Nothing OrElse nums.Count = 0 Then Return "-"

    If nums.Count = 1 Then Return nums(0)

    Dim lNums = nums.Distinct().OrderBy(Function(m) m).ToList

    Dim curPos As Long = 1
    Dim lastNum As Long = lNums(0)
    Dim i As Long = 0
    Dim numStr As String = lNums(0)
    Dim isGap As Boolean = False

    Do Until i >= lNums.Count - 1
        Do Until i >= lNums.Count - 1 OrElse lNums(i) + 1 <> lNums(i + 1)
            i += 1
            isGap = True
        Loop
        If isGap Then
            numStr += "-" & lNums(i)
        End If
        If i <> lNums.Count - 1 Then
            numStr += ", " & lNums(i + 1)
            isGap = False
            i += 1
        End If
    Loop

    Return numStr

End Function

在我为VBA重写之前，想知道是否有人有更好的方法吗？

Answer 1

我采取了漫长的路线：

Public Sub SortCollection(ByRef c As Collection)
Dim tmp
For i = 1 To c.Count - 1
    For j = i + 1 To c.Count
        If c(i) > c(j) Then
           vTemp = c(j)
           c.Remove j
           c.Add tmp, tmp, i
        End If
    Next j
Next i
End Sub


Public Function NumberListGrouped(cells As Range) As String

    If cells.Count = 0 Then
        AnimalIdListGrouped = "-"
    ElseIf cells.Count = 1 Then
        AnimalIdListGrouped = cells(1, 1)
    End If

    Dim c As New Collection

    On Error Resume Next
    For Each cell In cells
        c.Add CInt(cell.Value), CStr(cell.Value)
    Next cell
    SortCollection c
    On Error GoTo 0

    Dim i As Long: i = 1
    Dim numStr As String: numStr = c(1)
    Dim isGap As Boolean: isGap = False

    Do Until i >= c.Count
        DoEvents
        Do Until i >= c.Count Or c(i) + 1 <> c(i + 1)
            i = i + 1
            isGap = True
            DoEvents
        Loop
        If isGap Then
            numStr = numStr & "-" & c(i)
        End If
        If i <> c.Count Then
            numStr = numStr & ", " & c(i + 1)
            isGap = False
            i = i + 1
        End If
    Loop

    NumberListGrouped = numStr

End Function

Answer 2

如果您想要一个简单的方法，可以使用以下内容：

Function GroupedNumbers(nums() As Long) As String
    SortMe (nums) 'No built-in sort method in VBA,
                  'so you need to implement one yourself (see links below).
    Dim numStr As String
    numStr = nums(0)
    For i = 1 To UBound(nums)
        If nums(i) = nums(i - 1) + 1 Then
            numStr = numStr & IIf(nums(i) + 1 = nums(i + 1), "", "-" & nums(i))
        Else
            numStr = numStr & ", " & nums(i)
        End If
    Next i
    GroupedNumbers = numStr
End Function

对于数组排序，您可以参考this question。

如果你想要更简单的东西，请检查使用.NET版ArrayList进行排序的this answer。因此，您需要调整上述函数以使用ArrayList而不是Array。

希望有所帮助：）

Answer 3

如果您在Excel中使用VBA，您可以按照以下方式为您完成工作

Function GroupedNumbers(nums() As Long) As String
    Dim strng As String
    Dim i As Long

    For i = LBound(nums) To UBound(nums) - 1
        strng = strng & CStr(nums(i)) & ",A"
    Next i
    strng = "A" & strng & CStr(nums(i))
    GroupedNumbers = Replace(Replace(Replace(Intersect(Columns(1), Range(strng)).Address(False, False), ",A", ", "), "A", ""), ":", "-")
End Function

在VBA

3 个答案: