Right now, the input is like a list of fields:
"field1", "field2", field3", ...
And each of those fields match up with a string in the fields array based on the client's specifications.
I parse all of the fields and put them into a dictionary to use outside the function, the key being their corresponding name from the fields array. Then as a check if the input isn't way off base, I compare the length of the dictionary to the length of the fields array (+- 1 for a bit of flexibility).
Finally, the function returns True or False based on how "off" the input field length is from the fields array. The problem is the client will add additional fields like that may cause errors.
Is there a more flexible way to do this check to reduce the chance of these errors in the future?
Greatly appreciate your input.
Public Function parseCsv(ByVal csv As String, ByRef dict As Dictionary(Of String, String)) As Boolean
Dim fields As String() = New String() {"Patient_Name", "Date_of_Birth", "Address", "County"}
dict = New Dictionary(Of String, String)
Dim csvRegex As String = "(?:,""|^"")(""""|[\w\W]*?)(?="",|""$)|(?:,(?!"")|^(?!""))([^,]*?)(?=$|,)|(\r\n|\n)"
Dim fieldCount As Integer = 0
Try
Dim matches As MatchCollection = Regex.Matches(csv, csvRegex)
Dim m As Match
For index As Integer = 0 To matches.Count - 1
m = matches(index)
Dim fieldValue As String = ""
If m.Groups(1).ToString() IsNot "" Then
fieldValue = m.Groups(1).ToString()
ElseIf m.Groups(2).ToString() IsNot "" Then
fieldValue = m.Groups(2).ToString()
ElseIf m.Groups(3).ToString() IsNot "" Then
fieldValue = m.Groups(3).ToString()
End If
If index < fields.Length Then
dict.Add(fields(index), fieldValue)
End If
fieldCount += 1
Next
Catch ex As Exception
Return False
End Try
Return fieldCount = fields.Length Or fieldCount = fields.Length - 1 Or fieldCount = fields.Length + 1
End Function
Unfortunately, the input comes in as a big list of data and I can't control what it looks like.
Related
I have a macro that send an XMLHTTP request to a server and it gets as response a plain text string, not a JSON format string or other standard formats (at least for what I know).
I would like to parse the output string in order to access the data in an structured approach in the same fashion as the parseJson subroutine in this link
My problem is I am not good with regular expressions and I am not able to modify the routine for my needs.
The string that I need to parse has the following structure:
The string is a single line
Each single parameter is defined by its parameter name the equal simbol, its value and ending with; "NID=3;" or "SID=Test;"
Parameter can be collected in "structures" starts and end with the symbol | and they are identified with their name followed by ; such as |STEST;NID=3;SID=Test;|
A structure can contain also other structures
An example of a output string is the following
|KC;|AD;PE=5;PF=3;|CD;PE=5;HP=test;|CD;PE=3;HP=abc;|
In this case there is a macro structure KC which contains a structure AD. The structure AD is composed by the parameters PE, PF and 2 structures CD. And finaly the structures CD have the parameters PE and HP
So I would like to parse the string to obtain an Object/Dictionary that reflects this structure, can you help me?
Adds after the first answers
Hi all, thank you for your help, but I think I should make more clear the output that I would like to get.
For the example string that I have, I would like to have an object with the following structure:
<KC>
<AD>
<PE>5</PE>
<PF>3</PF>
<CD>
<PE>5</PE>
<HP>test</HP>
</CD>
<CD>
<PE>3</PE>
<HP>abc</HP>
</CD>
</AD>
</KC>
So I started to wrote a possible working code base on some hint from #Nvj answer and the answer in this link
Option Explicit
Option Base 1
Sub Test()
Dim strContent As String
Dim strState As String
Dim varOutput As Variant
strContent = "|KC;|AD;PE=5;PF=3;|CD;PE=5;HP=test;|CD;PE=3;HP=abc;|"
Call ParseString(strContent, varOutput, strState)
End Sub
Sub ParseString(ByVal strContent As String, varOutput As Variant, strState As String)
' strContent - source string
' varOutput - created object or array to be returned as result
' strState - Object|Array|Error depending on processing to be returned as state
Dim objTokens As Object
Dim lngTokenId As Long
Dim objRegEx As Object
Dim bMatched As Boolean
Set objTokens = CreateObject("Scripting.Dictionary")
lngTokenId = 0
Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = "\|[A-Z]{2};" 'Pattern for the name of structures
Tokenize objTokens, objRegEx, strContent, lngTokenId, bMatched, "str"
.Pattern = "[A-Z]{2}=[^\|=;]+;" 'Pattern for parameters name and values
Tokenize objTokens, objRegEx, strContent, lngTokenId, bMatched, "par"
End With
End Sub
Sub Tokenize(objTokens, objRegEx, strContent, lngTokenId, bMatched, strType)
Dim strKey As String
Dim strKeyPar As String
Dim strKeyVal As String
Dim strWork As String
Dim strPar As String
Dim strVal As String
Dim strLevel As String
Dim strRes As String
Dim lngCopyIndex As Long
Dim objMatch As Object
strRes = ""
lngCopyIndex = 1
With objRegEx
For Each objMatch In .Execute(strContent)
If strType = "str" Then
bMatched = True
With objMatch
strWork = Replace(.Value, "|", "")
strWork = Replace(strWork, ";", "")
strLevel = get_Level(strWork)
strKey = "<" & lngTokenId & strLevel & strType & ">"
objTokens(strKey) = strWork
strRes = strRes & Mid(strContent, lngCopyIndex, .FirstIndex - lngCopyIndex + 1) & strKey
lngCopyIndex = .FirstIndex + .Length + 1
End With
lngTokenId = lngTokenId + 1
ElseIf strType = "par" Then
strKeyPar = "<" & lngTokenId & "par>"
strKeyVal = "<" & lngTokenId & "val>"
strKey = strKeyPar & strKeyVal
bMatched = True
With objMatch
strWork = Replace(.Value, ";", "")
strPar = Split(strWork, "=")(0)
strVal = Split(strWork, "=")(1)
objTokens(strKeyPar) = strPar
objTokens(strKeyVal) = strVal
strRes = strRes & Mid(strContent, lngCopyIndex, .FirstIndex - lngCopyIndex + 1) & strKey
lngCopyIndex = .FirstIndex + .Length + 1
End With
lngTokenId = lngTokenId + 2
End If
Next
strContent = strRes & Mid(strContent, lngCopyIndex, Len(strContent) - lngCopyIndex + 1)
End With
End Sub
Function get_Level(strInput As String) As String
Select Case strInput
Case "KC"
get_Level = "L1"
Case "AD"
get_Level = "L2"
Case "CD"
get_Level = "L3"
Case Else
MsgBox ("Error")
End
End Select
End Function
This function creates a dictionary with an item for each structure name, parameter name and parameter value as shown in the figure
Thanks to the function get_Level the items associated to structures have a level that should help to preserve the original hierarchy of the data.
So what I am missing is a function to create an object that has the original structure of the input string. This is what the Retrieve function do in this answer link, but I do not know how to adapt it to my case
This looks like a simple nested delimited string. A couple of Split() functions will do the trick:
Option Explicit
Function parseString(str As String) As Collection
Dim a1() As String, i1 As Long, c1 As Collection
Dim a2() As String, i2 As Long, c2 As Collection
Dim a3() As String
a1 = Split(str, "|")
Set c1 = New Collection
For i1 = LBound(a1) To UBound(a1)
If a1(i1) <> "" Then
Set c2 = New Collection
a2 = Split(a1(i1), ";")
For i2 = LBound(a2) To UBound(a2)
If a2(i2) <> "" Then
a3 = Split(a2(i2), "=")
If UBound(a3) > 0 Then
c2.Add a3(1), a3(0)
ElseIf UBound(a3) = 0 Then
c2.Add a3(0)
End If
End If
Next i2
c1.Add c2
End If
Next i1
Set parseString = c1
End Function
Sub testParseString()
Dim c As Collection
Set c = parseString("|KC;|AD;PE=5;PF=3;|CD;PE=5;HP=test;|CD;PE=3;HP=abc;|")
Debug.Assert c(1)(1) = "KC"
Debug.Assert c(2)("PE") = "5"
Debug.Assert c(3)(1) = "CD"
Debug.Assert c(4)("HP") = "abc"
Debug.Assert c(4)(3) = "abc"
End Sub
Note that you can address values by both, index and key (if key existed in the input). If key was not provided you can only access the value by its index. You can also iterate collection recursively to get all the values in a tree structure.
Food for thought: since your structures may have repeated names (in your case "CD" structure happens twice) Collections / Dictionaries would find it problematic to store this elegantly (due to key collisions). Another good way to approach this is to create an XML structure with DOMDocument and use XPath to access its elements. See Program with DOM in Visual Basic
UPDATE: I've added XML example below as well. Have a look.
Here is another take on your string parsing issue using DOMDocument XML parser. You need to include Microsoft XML, v.6.0 in your VBA references.
Function parseStringToDom(str As String) As DOMDocument60
Dim a1() As String, i1 As Long
Dim a2() As String, i2 As Long
Dim a3() As String
Dim dom As DOMDocument60
Dim rt As IXMLDOMNode
Dim nd As IXMLDOMNode
Set dom = New DOMDocument60
dom.async = False
dom.validateOnParse = False
dom.resolveExternals = False
dom.preserveWhiteSpace = True
Set rt = dom.createElement("root")
dom.appendChild rt
a1 = Split(str, "|")
For i1 = LBound(a1) To UBound(a1)
If a1(i1) <> "" Then
a2 = Split(a1(i1), ";")
Set nd = dom.createElement(a2(0))
For i2 = LBound(a2) To UBound(a2)
If a2(i2) <> "" Then
a3 = Split(a2(i2), "=")
If UBound(a3) > 0 Then
nd.appendChild dom.createElement(a3(0))
nd.LastChild.Text = a3(1)
End If
End If
Next i2
rt.appendChild nd
End If
Next i1
Set parseStringToDom = dom
End Function
Sub testParseStringToDom()
Dim dom As DOMDocument60
Set dom = parseStringToDom("|KC;|AD;PE=5;PF=3;|CD;PE=5;HP=test;|CD;PE=3;HP=abc;|")
Debug.Assert Not dom.SelectSingleNode("/root/KC") Is Nothing
Debug.Assert dom.SelectSingleNode("/root/AD/PE").Text = "5"
Debug.Assert dom.SelectSingleNode("/root/CD[1]/HP").Text = "test"
Debug.Assert dom.SelectSingleNode("/root/CD[2]/HP").Text = "abc"
Debug.Print dom.XML
End Sub
As you can see this converts your text into an XML DOM document preserving all the structures and allowing for duplicates in naming. You can then use XPath to access any node or value. This can also be extended to have more nesting levels and further structures.
This is the XML document it creates behind the scenes:
<root>
<KC/>
<AD>
<PE>5</PE>
<PF>3</PF>
</AD>
<CD>
<PE>5</PE>
<HP>test</HP>
</CD>
<CD>
<PE>3</PE>
<HP>abc</HP>
</CD>
</root>
I've started to write a parser in VBA for the string structure specified by you, and it's not complete, but I'll post it anyways. Maybe you can pick up some ideas from it.
Sub ParseString()
Dim str As String
str = "|KC;|AD;PE=5;PF=3;|CD;PE=5;HP=test;|CD;PE=3;HP=abc;|"
' Declare an object dictionary
' Make a reference to Microsoft Scripting Runtime in order for this to work
Dim dict As New Dictionary
' If the bars are present in the first and last character of the string, replace them
str = Replace(str, "|", "", 1, 1)
If (Mid(str, Len(str), 1) = "|") Then
str = Mid(str, 1, Len(str) - 1)
End If
' Split the string by bars
Dim substring_array() As String
substring_array = Split(str, "|")
' Declare a regex object
' Check the reference to Microsoft VBScript Regular Expressions 5.5 in order for this to work
Dim regex As New RegExp
With regex
.Global = True
.IgnoreCase = True
.MultiLine = True
End With
' Object to store the regex matches
Dim matches As MatchCollection
Dim param_name_matches As MatchCollection
Dim parameter_value_matches As MatchCollection
' Define some regex patterns
pattern_for_structure_name = "^[^=;]+;"
pattern_for_parameters = "[^=;]+=[^=;]+;"
pattern_for_parameter_name = "[^=;]="
pattern_for_parameter_val = "[^=;];"
' Loop through the elements of the array
Dim i As Integer
For i = 0 To UBound(substring_array) - LBound(substring_array)
' Get the array element in a string
str1 = substring_array(i)
' Check if it contains a structure name
regex.Pattern = pattern_for_structure_name
Set matches = regex.Execute(str1)
If matches.Count = 0 Then
' This substring does not contain a structure name
' Check if it contains parameters
regex.Pattern = pattern_for_parameter
Set matches = regex.Execute(matches(0).Value)
If matches.Count = 0 Then
' There are no parameters as well as no structure name
' This means the string had || - invalid string
MsgBox ("Invalid string")
Else
' The string contains parameter names
' Add each parameter name to the dictionary
Dim my_match As match
For Each my_match In matches
' Get the name of the parameter
regex.Pattern = pattern_for_parameter_name
Set parameter_name_matches = regex.Execute(my_match.Value)
' Check if the above returned any matches
If parameter_name_matches.Count = 1 Then
' Remove = sign from the parameter name
parameter_name = Replace(parameter_name_matches(0).Value, "=", "")
' Get the value of the parameter
regex.Pattern = pattern_for_parameter_value
Set parameter_value_matches = regex.Execute(my_match.Value)
' Check if the above returned any matches
If parameter_value_matches.Count = 1 Then
' Get the value
parameter_value = Replace(parameter_value_matches(0).Value, ";", "")
' Add the parameter name and value as a key pair to the Dictionary object
dict.Item(parameter_name) = parameter_value
Else
' Number of matches is either 0 or greater than 1 - in both cases the string is invalid
MsgBox ("Invalid string")
End If
Else
' Parameter name did not match - invalid string
MsgBox ("Invalid string")
End If
Next
End If
ElseIf matches.Count = 1 Then
' This substring contains a single structure name
' Check if it has parameter names
Else
' This substring contains more than one structure name - the original string is invalid
MsgBox ("Invalid string")
End If
Next i
End Sub
in the following examples I need to get the words on either side on the period
I am using this regex
Dim myRegex As New Regex("[^\w]+")
Dim mymatch As String() = myRegex.Split(currentField)
where as currentfield = one of the following 3 samples
Contacts.Address2 as `Contact Address2`
Contacts.ContactID
CONCAT(Contacts.FirstName;;' ';;Contacts.LastName) as `Contact`
returns are as follows.
1-- Contacts, Address2, as, Contact and Address2 do not want the word as.
2-- Contacts and ContactID this is ok.
3-- CONCAT,Contacts,FirstName,Contacts,LastName,as and Contact.
3rd one this is too much do not want CONCAT,as or Contact. I only want the four words (ones before and after the period) to be returned Contacts, Firstname, Contacts, and Lastname
how can I write the regex to only get words before and after the period
I would consider matching vs. splitting the input:
For Each m As Match In Regex.Matches(input, "(\w+)\.(\w+)")
Console.WriteLine(
String.Join(", ",
m.Groups(1).Value,
m.Groups(2).Value
))
Next
This is an example, It's not clear what you expect to do with the returned results.
Ideone Demo
I think you are looking to only split inside round brackets and you are not interested in the word as. Thus, I suggest a 2 step approach:
Get the substring(s) in round brackets (\([^()]+\) regex)
If there are such substrings, split them with the split regex, if not, split the original string with split regex (\W+|\s*\bas\b\s* regex).
Sample code:
'Dim currentField As String = "Contacts.Address2 as `Contact Address2`"
Dim currentField As String = "CONCAT(Contacts.FirstName;;' ';;Contacts.LastName) as `Contact`"
'Dim currentField As String = "Contacts.ContactID"
Dim myRegex As New Regex("\([^()]+\)")
Dim splitRegex As New Regex("\W+|\s*\bas\b\s*")
Dim mymatch As MatchCollection = myRegex.Matches(currentField)
If mymatch.Count > 0 Then
For Each match As Match In mymatch
Dim mysubstrs As String() = splitRegex.Split(match.Value)
For Each substr As String In mysubstrs
If String.IsNullOrEmpty(substr) = False Then
Console.WriteLine(substr)
End If
Next
Next
Else
Dim mysubstrs As String() = splitRegex.Split(currentField)
For Each substr As String In mysubstrs
If String.IsNullOrEmpty(substr) = False Then
Console.WriteLine(substr)
End If
Next
End If
here is the final working routine, based on the accepted answer above
Public Sub Load_Field_List(FieldSTR As String, FieldType As String)
Dim t As New FileIO.TextFieldParser(New System.IO.StringReader(FieldSTR))
t.TextFieldType = Microsoft.VisualBasic.FileIO.FieldType.Delimited
t.Delimiters = New String() {","}
Dim currentRow As String()
Dim dr As DataRow
Dim ColListSTR As String = loadeddataview.Tables(0).Rows(0).Item("ColumnList")
Dim ColListSTRArr As String() = ColListSTR.Split(",")
While Not t.EndOfData
Try
currentRow = t.ReadFields()
Dim currentField As String 'field string
For Each currentField In currentRow
Dim startName As Integer
Dim endName As Integer
Dim name As String
dr = fieldDT.NewRow
Dim isValid As Boolean = False
If currentField = "" Then 'make sure current field has data
isValid = False
ElseIf (Regex.IsMatch(currentField, "(\w+)\.(\w+)")) = True Then 'make sure current field has xxxx.yyyy pattern
Dim m As Match = Regex.Match(currentField, "(\w+)\.(\w+)") 'sets m to the first xxxx.yyyy pattern
dr("Table") = m.Groups(1).Value 'sets table column to table name xxxx
dr("Column Name") = "`" & m.Groups(2).Value & "`" 'sets column name to column yyyy enclosed in ` `
If ColListSTRArr.Contains(m.Groups(2).Value) Then 'checks columnlist str to see if column visible
dr("Show") = "True"
Else
dr("Show") = "False"
End If
' this section overrides column name if it was set using AS `zzzzz` statement
startName = currentField.IndexOf("`")
endName = currentField.IndexOf("`", If(startName > 0, startName + 1, 0))
If (endName > startName) Then
Dim mylength As Integer = currentField.Length
name = currentField.Substring(startName, endName - startName + 1)
dr("Column Name") = name 'set override columname
dr("Field") = currentField.Substring(0, startName - 4) 'sets field minus the " as 'ZZZZZ" above
If ColListSTRArr.Contains(currentField.Substring(startName + 1, endName - startName - 1)) Then 'dup may be able to remove
dr("Show") = "True"
Else
dr("Show") = "False"
End If
Else
dr("Field") = currentField 'sets field if there was no " as `ZZZZZZ`" in string
End If
If FieldType = "Field" Then 'sets the column linking field
dr("Linking") = "No Linking"
Else
dr("Linking") = FieldType
End If
End If
' commit changes
fieldDT.Rows.Add(dr)
fieldDT.AcceptChanges()
DataGridView3.DataSource = fieldDT
DataGridView3.ClearSelection()
Next
Catch ex As Microsoft.VisualBasic.
FileIO.MalformedLineException
MsgBox("Line " & ex.Message &
"is not valid and will be skipped.")
End Try
End While
End Sub
I'm trying to change or update the code from detecting commas for pages,
The code below shows how to input pages with commas,
sample: 1,2,5,3,8 and it would not accept 0, or greater than the maximum page
What I'm asking is to add the code that would accept
like this:
2-5,8,9
or
8,9,2-5
or
2-5,8-10
so it means, pages to print are 2,3,4,5,8,9,10
BUT it will NOT accept input like 2-5,4,8,9 because 4 was already used in 2-5
if that could be hard then its ok to input a simple range like:
2-5 and no commas, so user could not input commas, if they want to input
comma then the -sign could not be input also.
''CODED By: Chris, Combined to MackieChan solution
Public Function isCELLPageNumb(ByRef valyo As String, ByVal origMaxPage As Integer) As Boolean
Dim rgxNumberWithComma As New System.Text.RegularExpressions.Regex("^([0-9]+,?)+$")
Dim match = rgxNumberWithComma.Match(valyo)
If Not match.Success Then
Return False
Else
Dim numbers As New List(Of Integer) 'will store added numbers
For Each Item In valyo.Split(","c)
Dim intValue As Integer
'Check if number is a valid integer
'Check if number is 0
'Check if number has already added the number list
'Check if number is greater that MaxPage
If Not Integer.TryParse(Item, intValue) _
OrElse intValue > origMaxPage _
OrElse intValue = 0 _
OrElse numbers.Contains(intValue) Then
Return False
Else
'Item is valid, continue
numbers.Add(intValue)
End If
Next
End If
Return True
End Function
Private Sub DbGridPapers_CellEndEdit(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DbGridPapers.CellEndEdit
Dim pagestoprint As String = Nothing
Try
pagestoprint = DbGridPapers.Rows(e.RowIndex).Cells(1).Value.ToString
Catch ex As Exception
End Try
If (e.ColumnIndex = 1) And (pagestoprint IsNot Nothing) Then
If Not isCELLPageNumb(DbGridPapers.Rows(e.RowIndex).Cells(1).Value, OrigPage(e.RowIndex)) Then
MyThreadedControl(lbltest, "Text", "INVALID INPUT FOR [PAGES] AT ROW " & (e.RowIndex).ToString)
DbGridPapers.Rows(e.RowIndex).Cells(1).Value = OrigPage(e.RowIndex)
Return
Else
MyThreadedControl(lbltest, "Text", "The Maximum Page is:" & OrigPage(e.RowIndex).ToString)
End If
Dim pageDest As String = Nothing
If Me.btnpaperpay.Enabled Then
pageDest = DbGridPapers.Rows(e.RowIndex).Tag & "\"
Else
pageDest = docPrintnationPath & "\"
End If
Dim filename As String = pageDest & DbGridPapers.Rows(e.RowIndex).HeaderCell.Value.ToString
Dim OldRegularPrice As Decimal = DbGridPapers.Rows(e.RowIndex).Cells(3).Value
Dim FILEpages As New List(Of Integer)
''IF , AND - CAN BE MIX TO GET THE PAGE THEN ITS BETTER, AND I HAVE TO UPDATE THE CODE HERE ALSO.
If pagestoprint.Split(",").Length > 1 Then 'Split Length is +1 based
Dim pageFILES() As String = pagestoprint.Split(",")
For Each filePids As Integer In pageFILES
FILEpages.Add(filePids) ''GET range in comma sample page1,page3,page8,page2
Next
ElseIf pagestoprint.Split("-").Length > 1 Then 'Split Length is +1 based
Dim pageFILES() As String = pagestoprint.Split("-")
For page As Integer = pageFILES(0) To pageFILES(1)
FILEpages.Add(page) ''GET range sample pages2 to page5
Next
Else
Dim pages As Integer
If (Integer.TryParse(pagestoprint, pages)) Then
If pages = OrigPage(e.RowIndex) Then
DbGridPapers.Rows(e.RowIndex).Cells(2).Value = OrigImage(e.RowIndex)
DbGridPapers.Rows(e.RowIndex).Cells(3).Value = OrigPay(e.RowIndex)
DbGridPapers.Rows(e.RowIndex).Cells(4).Value = OrigCountedImage(e.RowIndex)
GoTo pCounter ''Return Original Cells Value
Else
FILEpages.Add(pages)''GET single page only
End If
End If
End If
pCounter:
Dim paperToTpay As Decimal = txtpapertotpay.Text.Substring(0, txtpapertotpay.Text.LastIndexOf(" "))
paperToTpay -= OldRegularPrice
paperToTpay += DbGridPapers.Rows(e.RowIndex).Cells(3).Value
MyThreadedControl(txtpapertotpay, "Text", paperToTpay.ToString & " dollar(s)")
End If
End Sub
I think its very hard.
I understand that a custom algorithm is acceptable. Here you have an approach accounting for all the described conditions:
Private Function extractPages(ByVal inputString As String) As List(Of Integer)
Dim outList As List(Of Integer) = New List(Of Integer)
If (inputString.Contains(",")) Then
outList = extractCommas(inputString, outList)
ElseIf (inputString.Contains("-")) Then
outList = extractDashes(inputString, outList)
End If
If (outList.Count > 0) Then
For i As Integer = outList.Count - 1 To 0 Step -1
If (outList.IndexOf(outList(i)) <> outList.LastIndexOf(outList(i))) Then
'Repeated item
'It can be just deleted or shall the function return an error?
outList.RemoveAt(i)
End If
Next
End If
Return outList
End Function
Private Function extractCommas(ByVal inputString As String, curList As List(Of Integer)) As List(Of Integer)
If (inputString.Contains(",")) Then
Dim temp() As String = inputString.Split(",")
For Each item In temp
If (Not item.Contains("-") And IsNumeric(item)) Then
If (Convert.ToInt32(item.Trim()) > 0) Then
curList.Add(Convert.ToInt32(item.Trim()))
End If
ElseIf (item.Contains("-")) Then
curList = extractDashes(item.Trim(), curList)
End If
Next
End If
Return curList
End Function
Private Function extractDashes(ByVal inputString As String, curList As List(Of Integer)) As List(Of Integer)
If (inputString.Contains("-")) Then
Dim temp() = inputString.Split("-")
If (temp.Length = 2) Then
If (Convert.ToInt32(temp(0)) <= Convert.ToInt32(temp(1))) Then
Dim count As Integer = Convert.ToInt32(temp(0)) - 1
If (count < 0) Then
count = 0
End If
Do
count = count + 1
curList.Add(count)
Loop While (count < Convert.ToInt32(temp(1)))
End If
End If
End If
Return curList
End Function
You can call extractPages and get all the page numbers:
Dim InputString As String = "2-5, 4,8-10"
Dim allPages As List(Of Integer) = extractPages(InputString) 'It returns 2, 3, 4, 5, 8, 9, 10
Description
It's not exactly clear what you're looking for, but this powershell solution shows the logic behind how I would approach the problem to allow a user to input 0,2-5,4,8,9 so that the zero and extra redundant digits are ignored.
Example
$string = "0,2-5,4,8,9"
[hashtable]$hashPages = #{}
foreach ($chunk in $String -split ",") {
# if the string has a dash then process it as a range
if ($chunk -match "(\d+)-(\d+)") {
# itterate through all the pages in the range
foreach ($Page in $Matches[1] .. $Matches[2]) {
# insert this page into a hash, which will keep the numbers unique
$hashPages[[string]$Page] = $true
} # next page
} # end if
# if string is only a number then process it as a single number
if ($chunk -match "(\d+)") {
# insert this page into a hash, which will keep the numbers unique
$hashPages[[string]$Matches[1]] = $true
} # end if
} # next chunk
# remove the undesireable numbers like zero if they were added
$hashPages.Remove("0");
Write-Host "these pages where requested:" $(($hashPages.Keys | sort ) -join ",")
Output
these pages where requested: 2,3,4,5,8,9
I have a string as below, which needs to be split to an array, using VB.NET
10,"Test, t1",10.1,,,"123"
The result array must have 6 rows as below
10
Test, t1
10.1
(empty)
(empty)
123
So:
1. quotes around strings must be removed
2. comma can be inside strings, and will remain there (row 2 in result array)
3. can have empty fields (comma after comma in source string, with nothing in between)
Thanks
Don't use String.Split(): it's slow, and doesn't account for a number of possible edge cases.
Don't use RegEx. RegEx can be shoe-horned to do this accurately, but to correctly account for all the cases the expression tends to be very complicated, hard to maintain, and at this point isn't much faster than the .Split() option.
Do use a dedicated CSV parser. Options include the Microsoft.VisualBasic.TextFieldParser type, FastCSV, linq-to-csv, and a parser I wrote for another answer.
You can write a function yourself. This should do the trick:
Dim values as New List(Of String)
Dim currentValueIsString as Boolean
Dim valueSeparator as Char = ","c
Dim currentValue as String = String.Empty
For Each c as Char in inputString
If c = """"c Then
If currentValueIsString Then
currentValueIsString = False
Else
currentValueIsString = True
End If
End If
If c = valueSeparator Andalso not currentValueIsString Then
If String.IsNullOrEmpty(currentValue) Then currentValue = "(empty)"
values.Add(currentValue)
currentValue = String.Empty
End If
currentValue += c
Next
Here's another simple way that loops by the delimiter instead of by character:
Public Function Parser(ByVal ParseString As String) As List(Of String)
Dim Trimmer() As Char = {Chr(34), Chr(44)}
Parser = New List(Of String)
While ParseString.Length > 1
Dim TempString As String = ""
If ParseString.StartsWith(Trimmer(0)) Then
ParseString = ParseString.TrimStart(Trimmer)
Parser.Add(ParseString.Substring(0, ParseString.IndexOf(Trimmer(0))))
ParseString = ParseString.Substring(Parser.Last.Length)
ParseString = ParseString.TrimStart(Trimmer)
ElseIf ParseString.StartsWith(Trimmer(1)) Then
Parser.Add("")
ParseString = ParseString.Substring(1)
Else
Parser.Add(ParseString.Substring(0, ParseString.IndexOf(Trimmer(1))))
ParseString = ParseString.Substring(ParseString.IndexOf(Trimmer(1)) + 1)
End If
End While
End Function
This returns a list. If you must have an array just use the ToArray method when you call the function
Why not just use the split method?
Dim s as String = "10,\"Test, t1\",10.1,,,\"123\""
s = s.Replace("\"","")
Dim arr as String[] = s.Split(',')
My VB is rusty so consider this pseudo-code
I'm trying to get the code below to send the results of the regexp search to an array of strings. How can I do that?
When I change name to an array of strings i.e. Dim name() as String VBA throws a type-mismatch exception. Any idea what I can do to fix that?
Many thanks.
Do While Not EOF(1)
Line Input #1, sText
If sText <> "" Then
Dim Regex As Object, myMatches As Object
' instantiates regexp object
Set Regex = CreateObject("VBScript.RegExp")
With Regex
.MultiLine = False
.Global = True
.IgnoreCase = False
.Pattern = "^Personal\sname\s*[:]\s*"
End With
' get name, seperated from Personal Name
If Regex.test(sText) Then
Set myMatches = Regex.Execute(sText)
Dim temp As String
temp = Regex.Replace(sText, vbNullString)
Regex.Pattern = "^[^*]*[*]+"
Set myMatches = Regex.Execute(temp)
Dim temp2 As String
temp2 = myMatches.Item(0)
name = Trim(Left(temp2, Len(temp2) - 3))
End If
End If
Loop
You should not use "name" as a variable name as it conflicts with an excel property. Try sName or sNames instead, where s is for string.
With a array you need to give it a size before you can assign a value to each element.
Dim sNames(4) As String '// Or Dim sNames(1 To 4) As String
sName(1) = "John"
...
sName(4) = "Sam"
or if you don't know the total number of elements (names) to begin with then:
Dim sNames() As String
Dim iTotalNames As Integer
iTotalNames = '// Some code here to determine how many names you will have
ReDim sNames(iTotalNames) '// You can also use ReDim Preserve if you have existing elements
sName(1) = "John"
...
sName(4) = "Sam"
So I suspect you will need something like:
Dim sNames() As String
Dim iTotalNames As Integer
'// Your code ....
iTotalNames = iTotalNames + 1
ReDim Preserve sNames(iTotalNames)
sNames(iTotalNames) = Trim(Left(temp2, Len(temp2) - 3))
'// Rest of your code ...
Also in VBA all dimensioning of variables should be at the top of the module.
change
'call this "A"
Dim temp2 As String
temp2 = myMatches.Item(0)
to
'stick this at the top
redim temp2(0 to 0)
'replace "A" with this
new_top = ubound(temp2)+1
redim preserve temp2 (0 to new_top)
temp2(new_top) = myMatches.Item(0)