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