VB and VBA Users Source Code: Convert an array to a string and a string to an array
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Convert an array to a string and a string to an array
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Thursday, March 08, 2001
Hits:
959
Category:
Visual Basic General
Article:
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 'Author : Andrew Baker 'Date : 25/03/2000 '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 'Author : Andrewb 'Date : 17/08/2000 '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. 'Author : Andrew Baker 'Date : 25/03/2000 '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 'Author : Andrew Baker 'Date : 09/10/2000 23:39 '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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
