Visual Basic for Applications/Character 1D Arrays
Appearance
Summary
[edit | edit source]- This VBA code module is intended for any Microsoft Office application that supports VBA.
- It allows strings to be loaded into one-dimensional arrays one character per element, and to join such array characters into single strings again.
- The module is useful in splitting the characters of a single word ,something that the Split method cannot handle.
Notes on the code
[edit | edit source]Copy all of the procedures below into a VBA standard module, save the workbook as a xlsm type, then run the top procedure to show that the process is accurate.
The VBA Code Module
[edit | edit source]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