Visual Basic Programming Code Examples
Visual Basic > Strings Code Examples
Convert an array to a string and a string to an array
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
Convert an array to a string and a string to an array
The following routines are useful when converting an array to string or a string to array.
Option Explicit
'Purpose : Converts a 1d or 2d array to a deliminated String
'Inputs : avInArray The array to convert to a string
' sDelimRows Delimeter to seperate rows
' sDelimCols Delimeter to seperate columns (for 2d arrays)
'Outputs : A string containing all the elements of avInArray seperated by sDelimRows
'Notes :
Function ArrayToString(avInArray As Variant, Optional sDelimRows As String = "", Optional sDelimCols As String = "") As String
Dim lThisItem As Long, lNumItems As Long, lFirstRow As Long, lLastRow As Long
Dim lThisRow As Long, lThisCol As Long, lFirstCol As Long, lLastCol As Long
On Error GoTo ExitProc
Select Case ArrayNumDimensions(avInArray)
Case 0
'Empty array
Case 1
'1D Array
For lThisItem = LBound(avInArray) To UBound(avInArray)
ArrayToString = ArrayToString & (CStr(avInArray(lThisItem)) & sDelimRows) 'Join the small to the large
Next
Case 2
'2D Arrays
lFirstRow = LBound(avInArray, 2)
lLastRow = UBound(avInArray, 2)
lFirstCol = LBound(avInArray, 1)
lLastCol = UBound(avInArray, 1)
'Loop over each column then row to create the result string
For lThisCol = lFirstCol To lLastCol
For lThisRow = lFirstRow To lLastRow
ArrayToString = ArrayToString & (CStr(avInArray(lThisCol, lThisRow)) & sDelimRows) 'Join the small to the large
Next
ArrayToString = ArrayToString & sDelimCols
Next
Case Else
MsgBox "ArrayToString: Invalid array structure"
End Select
ExitProc:
On Error GoTo 0
End Function
'Purpose : Converts a string to string array.
'Inputs : sThisString The string to convert to an array
' asResults String array containing results
' sDelimRows Delimeter to seperate rows
' sDelimCols Delimeter to seperate columns (for 2d arrays)
'Outputs : N/A
'Notes :
'Revisions :
Sub StringToArray(ByVal sThisString As String, asResults() As String, Optional sDelimRows As String = "", Optional sDelimCols As String = "")
Dim lPos1dDel As Long, lPos2dDel As Long, lLenString As Long, lColSepLen As Long
Dim lLastPos As Long, lNumCols As Long, lThisRow As Long, lThisCol As Long, lRowSepLen As Long
lLenString = Len(sThisString)
If lLenString Then
lLastPos = 1
lPos1dDel = InStr(1, sThisString, sDelimRows)
lPos2dDel = InStr(1, sThisString, sDelimCols)
lNumCols = StringCount(sThisString, sDelimCols, vbTextCompare)
lRowSepLen = Len(sDelimRows)
If lNumCols Then
'Convert a 2d string
lThisCol = 1
lColSepLen = Len(sDelimCols)
'Create buffer to store results
On Error GoTo 0
ReDim asResults(1 To lNumCols, 1 To Int(lLenString / 2))
Do While lPos1dDel
lThisRow = lThisRow + 1
If lPos1dDel > lPos2dDel Then
'Next Column
lThisCol = lThisCol + 1
lThisRow = 0
lPos2dDel = InStr(lPos2dDel + 1, sThisString, sDelimCols)
lLastPos = lLastPos + lColSepLen
Else
'Store Row
asResults(lThisCol, lThisRow) = Mid$(sThisString, lLastPos, lPos1dDel - lLastPos)
lLastPos = lPos1dDel + lRowSepLen
End If
lPos1dDel = InStr(lLastPos, sThisString, sDelimRows)
Loop
ReDim Preserve asResults(1 To lNumCols, 1 To lThisRow)
Else
'Convert a 1d string
'Create buffer to store results
ReDim asResults(1 To Int(lLenString / 2))
lPos1dDel = InStr(lLastPos, sThisString, sDelimRows)
Do While lPos1dDel
lThisRow = lThisRow + 1
asResults(lThisRow) = Mid$(sThisString, lLastPos, lPos1dDel - lLastPos)
lLastPos = lPos1dDel + lRowSepLen
lPos1dDel = InStr(lLastPos, sThisString, sDelimRows)
Loop
ReDim Preserve asResults(1 To lThisRow)
End If
Else
Erase asResults
End If
End Sub
'Purpose : Calculates the number of dimensions in an array
'Inputs : avInArray. The array to evaluate.
'Outputs : The number of dimensions the array has.
'Notes :
Function ArrayNumDimensions(avInArray As Variant) As Long
Dim lNumDims As Long
If IsArray(avInArray) Then
On Error GoTo ExitSub
Do
lNumDims = UBound(avInArray, ArrayNumDimensions + 1)
ArrayNumDimensions = ArrayNumDimensions + 1
Loop
End If
ExitSub:
On Error GoTo 0
End Function
'Purpose : Count the number of matching instances of one string within another
'Inputs : sSearchString The string to search
' sForItem The string to search for
' [tCompare] The method of comparison. Defaults to a case insensative search.
' Can also specify vbBinaryCompare.
'Outputs : Returns the number of instances of the sForItem within sSearchString
'Notes :
'Revisions :
Function StringCount(sSearchString As String, sForItem As String, Optional tCompare As Long = vbTextCompare) As Long
Dim lPos As Long, lLenItem As Long
lLenItem = Len(sForItem)
Do
lPos = InStr(lPos + lLenItem, sSearchString, sForItem, tCompare)
If lPos Then
StringCount = StringCount + 1
Else
Exit Do
End If
Loop
End Function
