Visual Basic for Applications/字符一维数组

摘要

• 此 VBA 代码模块适用于任何支持 VBA 的 Microsoft Office 应用程序。
• 它允许将字符串加载到一维数组中，每个元素一个字符，并将这些数组字符再次连接成单个字符串。
• 该模块在拆分单个单词的字符时很有用，这是 Split 方法无法处理的。

代码说明

将下面所有的过程复制到 VBA 标准模块中，将工作簿保存为 xlsm 类型，然后运行顶层过程以证明该过程是准确的。

VBA 代码模块

Sub testStrTo1DArr()
    ' run this to test array string load
    ' and array to string remake procedures
    
    Dim vR As Variant, vE As Variant
    Dim sStr As String, bOK As Boolean, sOut As String
    
    sStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
    
    'split string into array elements
    bOK = StrTo1DArr(sStr, vR, False)
    
    If bOK = True Then
        'optional array transfer
        vE = vR
        
        'remake string from array
        sOut = Arr1DToStr(vE)
        
        'show that output = input
        MsgBox sStr & vbCrLf & sOut
    Else
        Exit Sub
    End If

End Sub

Function StrTo1DArr(ByVal sIn As String, vRet As Variant, _
                    Optional ByVal bLB1 As Boolean = True) As Boolean
    ' Loads string characters into 1D array (vRet). One per element.
    ' Optional choice of lower bound. bLB1 = True for one-based (default),
    ' else bLB1 = False for zero-based. vRet dimensioned in proc.

    Dim nC As Long, sT As String
    Dim LB As Long, UB As Long
    
    If sIn = "" Then
        MsgBox "Empty string - closing"
        Exit Function
    End If
    
    'allocate array for chosen lower bound
    If bLB1 = True Then
        ReDim vRet(1 To Len(sIn))
    Else
        ReDim vRet(0 To Len(sIn) - 1)
    End If
    LB = LBound(vRet): UB = UBound(vRet)

    'load charas of string into array
    For nC = LB To UB
        If bLB1 = True Then
            sT = Mid$(sIn, nC, 1)
        Else
            sT = Mid$(sIn, nC + 1, 1)
        End If
        vRet(nC) = sT
    Next

    StrTo1DArr = True

End Function
    
Function Arr1DToStr(vIn As Variant) As String
    ' Makes a single string from 1D array string elements.
    ' Works for any array bounds.
        
    Dim nC As Long, sT As String, sAccum As String
    Dim LB As Long, UB As Long
    
    LB = LBound(vIn): UB = UBound(vIn)

    'join characters of array into string
    For nC = LB To UB
        sT = vIn(nC)
        sAccum = sAccum & sT
    Next

    Arr1DToStr = sAccum

End Function