在 VBA 中将文本列表转换为数字列表/数组

Question

我有一个元素列表，作为以下格式的文本字符串，例如：

1 2 5to7 9 10to14by2

我正在尝试在 VBA（或基础 Excel 365，如果更简单的话）中将字符串转换为它所代表的数字的完整列表。

1,2,5,6,7,9,10,12,14

我并不担心输出格式是否以另一个字符串或数组等形式结束。

我使用

Split

函数将原始字符串分成几部分。如果全部都是单个数字，这允许我生成一个列表，但由于“to”语句，我无法生成完整列表。

Answer 1

尝试使用

split

是正确的 - 这将创建一个“单词”列表（您将其称为“部分”）。现在你需要解决两个问题：第一是处理这些部分，第二是如何组合结果。

由于 VBA 在动态数组方面相当差，我选择使用

Dictionary

来实现。由于我始终主张早期绑定，因此您需要添加对“Scripting.Library”的引用，请参阅VBA 是否有字典结构？。

要处理一个部分，请仔细观察它：每个部分都以一个数字开头，可选后跟“to”和另一个数字，可选后跟“by”和第三个数字。当您用空格替换这些关键字时，“10to14by2”将生成“10 14 2”。现在再次使用 split，您将获得

For

循环所需的值：开始值、结束值和步长值。

为了保持代码简单，我假设输入中没有语法错误（例如没有其他字符，多余的空格...）。如果不是这种情况，您将需要考虑错误处理。

以下代码使用两个函数：一个将输入字符串拆分为多个部分并循环遍历这些部分，第二个用于处理单个部分。我认为代码相当容易理解：

Function CreateNumberVector(s As String) As Dictionary
    Dim dict As Dictionary
    Set dict = New Dictionary
    
    Dim sections() As String, i As Long
    sections = Split(s, " ")
    For i = LBound(sections) To UBound(sections)
        handleSection dict, sections(i)
    Next i
    
    Set CreateNumberVector = dict

End Function

Sub handleSection(dict As Dictionary, ByVal section As String)
    ' Input: 10to14by2
    ' Output: 10, 12, 14 added to dict
    section = Replace(section, "to", " ")
    section = Replace(section, "by", " ")
    Dim tokens() As String
    tokens = Split(section, " ")

    ' Now we have an array 10, 14, 2       
    Dim fromVal As Long, toVal As Long, stepVal As Long
    fromVal = Val(tokens(0))      ' Startvalue for the loop
    If UBound(tokens) > 0 Then    ' Endvalue for the loop
        toVal = Val(tokens(1))
    Else
        toVal = fromVal           ' If nothing provided, Endvalue=Startvalue
    End If
    
    If UBound(tokens) > 1 Then    ' Step for the loop
        stepVal = Val(tokens(2))
    Else
        stepVal = 1               ' If nothing provided, step=1
    End If
    
    ' Now execute the loop and add the values to the dictionary
    Dim n As Long
    For n = fromVal To toVal Step stepVal
        dict(n) = n
    Next
End Sub

测试一下：

Sub test()
    Const s = "1 2 5to7 9 10to14by2"
    Dim dict As Dictionary
    Set dict = CreateNumberVector(s)
    Debug.Print Join(dict.Keys, ", ")
End Sub

将打印

1, 2, 5, 6, 7, 9, 10, 12, 14

到立即窗口。

请注意，字典是未排序的，并且会按照添加的顺序吐出键，因此输入“3, 10, 5to7”将导致“3, 10, 5, 6, 7”。如果您需要对它们进行排序，请搜索“按键对字典进行排序”。

Answer 2

从特殊字符串中检索整数

测试

Sub GetNumbersTEST()

    Const SpecialString As String = "1 2 7to5 9 14to10by2"
    
    Dim Numbers As Variant: Numbers = GetNumbers(SpecialString)
    
    If IsEmpty(Numbers) Then
        MsgBox "The supplied string """ & SpecialString & """ is invalid.", _
            vbCritical
    Else
        MsgBox Join(Numbers, ", ")
    End If

End Sub

功能

Function GetNumbers( _
    ByVal SpecialString As String, _
    Optional ByVal TermDelimiter As String = " ", _
    Optional ByVal RangeDelimiter As String = "to", _
    Optional ByVal StepDelimiter As String = "by") _
As Variant

    If Len(SpecialString) = 0 Then Exit Function

    Dim Terms() As String: Terms = Split(SpecialString, TermDelimiter)
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim rArr, sArr, Term, n As Long, pRange As Long, pStep As Long
    Dim First As Long, Last As Long, Step As Long
    
    For Each Term In Terms
        If IsNumeric(Term) Then
            dict(CLng(Term)) = Empty
        Else
            pRange = InStr(1, Term, RangeDelimiter, vbTextCompare)
            If pRange > 0 Then
                rArr = Split(Term, RangeDelimiter)
                If IsNumeric(rArr(0)) Then
                    First = CLng(rArr(0))
                    If IsNumeric(rArr(1)) Then
                        Last = CLng(rArr(1))
                        Step = IIf(First <= Last, 1, -1)
                    Else
                        pStep = InStr(1, rArr(1), StepDelimiter, vbTextCompare)
                        If pStep > 0 Then
                            sArr = Split(rArr(1), StepDelimiter)
                            If IsNumeric(sArr(0)) Then
                                Last = CLng(sArr(0))
                                If IsNumeric(sArr(1)) Then
                                    Step = IIf(First <= Last, _
                                        CLng(sArr(1)), -CLng(sArr(1)))
                                End If
                            End If
                        End If
                    End If
                End If
            End If
            If Step <> 0 Then
                For n = First To Last Step Step
                    dict(n) = Empty
                Next n
                Step = 0
            End If
        End If
    Next Term
                            
    If dict.Count > 0 Then
        GetNumbers = dict.Keys
    End If
                            
End Function

Answer 3

此解决方案期望输入字符串仅包含数字、“to”元素（例如“5to6”）或“to-by”元素（例如“10to20by5”）...每个元素均由一个空格分隔。其他任何情况都会导致调用代码需要处理的错误。

请参阅代码中的注释以了解每个步骤的说明。

Function GetNumbers(inputText As String) As String
    Dim aTexts() As String
    ' split the supplied inputText into individual elements - assumes each element is split based on space chars
    aTexts = Split(inputText, " ")
    Dim outputText As String, i As Long
    ' iterate over each element
    For i = LBound(aTexts) To UBound(aTexts)
        ' if it is just a number then add it to the output text
        If IsNumeric(aTexts(i)) Then
            outputText = outputText & CStr(aTexts(i))
        Else
            ' otherwise it is a 'range' with 'to' and possible 'by'
            Dim indexTo As Long, indexBy As Long, fromNum As Long, toNum As Long, stepNum As Long
            indexTo = InStr(1, aTexts(i), "to", vbTextCompare)
            indexBy = InStr(1, aTexts(i), "by", vbTextCompare)
            fromNum = CLng(Left$(aTexts(i), indexTo - 1))
            If indexBy = 0 Then
                ' there is no 'by'
                toNum = CLng(Mid$(aTexts(i), indexTo + 2))
                stepNum = 1
            Else
                ' there is a 'by'
                toNum = CLng(Mid$(aTexts(i), indexTo + 2, indexBy - indexTo - 2))
                stepNum = CLng(Mid$(aTexts(i), indexBy + 2))
            End If
            ' add the number in the 'range'
            Dim j As Long
            For j = fromNum To toNum Step stepNum
                outputText = outputText & CStr(j) & IIf(j = toNum, vbNullString, ", ")
            Next j
        End If
        ' unless we have just added the very last number to the output text, add ", "
        If i < UBound(aTexts) Then
            outputText = outputText & ", "
        End If
    Next i
    ' return the output text
    GetNumbers = outputText
End Function

使用示例：

Debug.Print GetNumbers("1 2 5to7 9 10to14by2")

结果

1, 2, 5, 6, 7, 9, 10, 12, 14