'I Have the below String.. that splited with "#"
myStr = "78,6$25,01|25,02|25,03|25,04#74,5$15,01|15,02|15,03|15,04#70,1$25,06|25,07|25,08|25,09#77,3$25,07|25,08|25,09|25,10#78,2$10,05|10,06|10,07|10,08"
'And I want resort to this New String with New Grouping...
'i should group splited string with first value after dollar($) chrachter
But i dont know how should I Sorting and Grouping to new desired result:
myStrDesired = "78,2$10,05|10,06|10,07|10,08#74,5$15,01|15,02|15,03|15,04#78,6$25,01|25,02|25,03|25,04#70,1$25,06|25,07|25,08|25,09#77,3$25,07|25,08|25,09|25,10"
My Script:
Function GroupArrays()
myStr = "78,6$25,01|25,02|25,03|25,04#74,5$15,01|15,02|15,03|15,04#70,1$25,06|25,07|25,08|25,09#77,3$25,07|25,08|25,09|25,10#78,2$10,05|10,06|10,07|10,08"
'And I want resort to this New String with New Grouping...
'i should group splited string with first value after dollar($) chrachter
myStrDesired = "78,2$10,05|10,06|10,07|10,08#74,5$15,01|15,02|15,03|15,04#78,6$25,01|25,02|25,03|25,04#70,1$25,06|25,07|25,08|25,09#77,3$25,07|25,08|25,09|25,10"
arrMyStr = Split(myStr,"#")
arrMyStrDesired = ""
for i = 0 to UBound(arrMyStr)
' find group id from each string
groupVal = Split(Split(arrMyStr(i),"$")(1),",")(0)
' put the same groups together and split them by "#" And finally the isolation of other disciplines with "#"
arrMyStrDesired = arrMyStrDesired & arrMyStr(i)
next
GroupArrays = arrMyStrDesired
End Function
New Description:*
Split the main String by "#".
In the each parts splited... see the first value after "$" and name to "groupId". (it is Important parameter for Grouping and sorting)
All of each parts has same groupId should be placed side by side and Joined by "#".
After above Steps... we should Join All New strings with other groupId by "#".... same as ... (00$01,05#01,06#...#02,07#03,4.....)
The following should work on any Windows machine with the Dot Net runtime. If for some reason you don't have that -- would need a custom sort:
myStr = "78,6$25,01|25,02|25,03|25,04#74,5$15,01|15,02|15,03|15,04#70,1$25,06|25,07|25,08|25,09#77,3$25,07|25,08|25,09|25,10#78,2$10,05|10,06|10,07|10,08"
myDesiredStr = "78,2$10,05|10,06|10,07|10,08#74,5$15,01|15,02|15,03|15,04#78,6$25,01|25,02|25,03|25,04#70,1$25,06|25,07|25,08|25,09#77,3$25,07|25,08|25,09|25,10"
Function GroupVal(group)
A = Split(group,"$")
B = Split(A(1),",")
GroupVal = CInt(B(0))
End Function
Function ReSort(str)
Set D = CreateObject("Scripting.Dictionary")
Set keyList = CreateObject("System.Collections.ArrayList")
groups = Split(str,"#")
For i = 0 to UBound(groups)
group = groups(i)
v = GroupVal(group)
If D.Exists(v) Then
D.Item(v) = D.Item(v) & "#" & group
Else
D.Add v,group
keyList.Add v
End If
Next
keyList.Sort()
newGroups = Array()
ReDim newGroups(Ubound(groups))
i = -1
For Each v In keyList
i = i + 1
newGroups(i) = D.item(v)
Next
ReDim Preserve newGroups(i)
Resort = Join(newGroups,"#")
End Function
MsgBox myDesiredStr = Resort(myStr)
The msgbox pops up True
Related
Kind of new to VBS. I'm trying to count the fields in the file and have this code.
Col()
Function Col()
Const FSpec = "C:\test.txt"
Const del = ","
dim fs : Set fs = CreateObject("Scripting.FileSystemObject")
dim f : Set f = fs.OpenTextFile(FSpec, 1)
Dim L, C
Do Until f.AtEndOfStream
L = f.ReadLine()
C = UBound(Split(L, del))
C = C +1
WScript.Echo "Items:", C
Loop
f.Close
End Function
It works however, I don't want to count the delim inside " ".
Here's file content:
1,"2,999",3
So basically, I'm getting 4 items for now but I wanted to get 3. Kind of stuck here.
For an example of my second suggestion, a very simple example could be something like this. Not saying it is perfect, but it illustrates the idea:
Dim WeAreInsideQuotes 'global flag
Function RemoveQuotedCommas(ByVal line)
Dim i
Dim result
Dim current
For i = 1 To Len(line)
current = Mid(line, i, 1) 'examine character
'check if we encountered a quote
If current = Chr(34) Then
WeAreInsideQuotes = Not WeAreInsideQuotes 'toggle flag
End If
'process the character
If Not (current = Chr(44) And WeAreInsideQuotes) Then 'skip if comma and insode quotes
result = result & current
End If
Next
RemoveQuotedCommas = result
End Function
hi all i have this question as bellow
how capitalize full in one vb6 Vb6 string variable
‘example
‘my fullname
Dim fullname as string
Fullname = “abdirahman abdirisaq ali”
Msgbox capitalize(fullname)
it prints abdirahmanAbdirisaq ali that means it skips the middle name space even if I add more spaces its same .
this is my own code and efforts it takes me at least 2 hours and still .
I tired it tired tired please save me thanks more.
Please check my code and help me what is type of mistakes I wrote .
This is my code
Private Function capitalize(txt As String) As String
txt = LTrim(txt)
temp_str = ""
Start_From = 1
spacing = 0
For i = 1 To Len(txt)
If i = 1 Then
temp_str = UCase(Left(txt, i))
Else
Start_From = Start_From + 1
If Mid(txt, i, 1) = " " Then
Start_From = i
spacing = spacing + 1
temp_str = temp_str & UCase(Mid(txt, Start_From + 1, 1))
Start_From = Start_From + 1
Else
temp_str = temp_str & LCase(Mid(txt, Start_From, 1))
End If
End If
Next i
checkName = temp_str
End Function
It's far simpler than that. In VB6 you should use Option Explicit to properly type your variables. That also requires you to declare them.
Option Explicit
Private Function capitalize(txt As String) As String
Dim temp_str as String
Dim Names As Variant
Dim Index As Long
'Remove leading and trailing spaces
temp_str = Trim$(txt)
'Remove any duplicate spaces just to be sure.
Do While Instr(temp_str, " ") > 0
temp_str = Replace(temp_str, " ", " ")
Loop
'Create an array of the individual names, separating them by the space delimiter
Names = Split(temp_str, " ")
'Now put them, back together with capitalisation
temp_str = vbnullstring
For Index = 0 to Ubound(Names)
temp_str = temp_str + Ucase$(Left$(Names(Index),1)) + Mid$(Names(Index),2) + " "
Next
'Remove trailing space
capitalize = Left$(temp_str, Len(temp_str) - 1)
End Function
That's the fairly easy part. If you are only going to handle people's names it still needs more work to handle names like MacFarland, O'Connor, etc.
Business names get more complicated with since they can have a name like "Village on the Lake Apartments" where some words are not capitalized. It's a legal business name so the capitalization is important.
Professional and business suffixes can also be problematic if everything is in lower case - like phd should be PhD, llc should be LLC, and iii, as in John Smith III, would come out Iii.
There is also a VB6 function that will capitalize the first letter of each word. It is StrConv(string,vbProperCase) but it also sets everything that is not the first letter to lower case. So PhD becomes Phd and III becomes Iii. Where as the above code does not change the trailing portion to lower case so if it is entered correctly it remains correct.
Try this
Option Explicit
Private Sub Form_Load()
MsgBox capitalize("abdirahman abdirisaq ali")
MsgBox capitalize("abdirahman abdirisaq ali")
End Sub
Private Function capitalize(txt As String) As String
Dim Names() As String
Dim NewNames() As String
Dim i As Integer
Dim j As Integer
Names = Split(txt, " ")
j = 0
For i = 0 To UBound(Names)
If Names(i) <> "" Then
Mid(Names(i), 1, 1) = UCase(Left(Names(i), 1))
ReDim Preserve NewNames(j)
NewNames(j) = Names(i)
j = j + 1
End If
Next
capitalize = Join(NewNames, " ")
End Function
Use the VB6 statement
Names = StrConv(Names, vbProperCase)
it's all you need (use your own variable instead of Names)
I'm trying to find a better solution for the integration of a string and generate a new field with the maximum value of the parameter. #AutomatedChaos has helped me with the following code. But I need a better solution for the flexibility of the code.
First string split by * (stars) and I want to merge all items and create a new string with max value.
fString = "projects#dnProjectsPatterning=0|dnProjectsSendReport=1#workplans#dnWorkplansAdd=0|dnWorkplansGrouping=1*projects#dnProjectsPatterning=1|dnProjectsSendReport=3#workplans#dnWorkplansAdd=1|dnWorkplansGrouping=0*projects#dnProjectsPatterning=5|dnProjectsSendReport=1#workplans#dnWorkplansAdd=0|dnWorkplansGrouping=2"
Set dict = CreateObject("Scripting.Dictionary")
Set re = New RegExp
re.Global = True
re.Pattern = "(\w+)=(\d+)"
Set matches = re.Execute(fString)
For Each match In matches
key = match.Submatches(0)
value = CInt(match.Submatches(1))
If dict.Exists(key) Then
If value < dict.Item(key) then
value = dict.Item(key)
End If
End If
dict.Item(key) = value
Next
For Each key In dict
MsgBox key & "=" & dict.Item(key)
Next
' output:
' dnProjectsPatterning=5
' dnProjectsSendReport=3
' dnWorkplansAdd=1
' dnWorkplansGrouping=2
I want to generate this string:
newString = "projects#dnProjectsPatterning=5|dnProjectsSendReport=3#workplans#dnWorkplansAdd=1|dnWorkplansGrouping=2"
Please note for projects# and workplans#, the two are split by #.
Here's another example that will work if the parameters are always ordered as shown.
The following code simply treats all separators except * as part of the keys. You can look at this regexr shot to see how the pattern works.
fString = "projects#dnProjectsPatterning=0|dnProjectsSendReport=1#workplans#dnWorkplansAdd=0|dnWorkplansGrouping=1*projects#dnProjectsPatterning=1|dnProjectsSendReport=3#workplans#dnWorkplansAdd=1|dnWorkplansGrouping=0*projects#dnProjectsPatterning=5|dnProjectsSendReport=1#workplans#dnWorkplansAdd=0|dnWorkplansGrouping=2"
Set params = CreateObject("Scripting.Dictionary")
With (New RegExp)
.Global = True
.Pattern = "([^=*]*)=(\d+)"
For Each match In .Execute(fString)
key = match.Submatches(0)
val = match.Submatches(1)
If params.Exists(key) Then
If val > params(key) Then params(key) = val
Else
params.Add key, val
End If
Next
End With
'temporary str dictionary to generate string
Set str = CreateObject("Scripting.Dictionary")
For Each key In params
'prepend key + "=" into items to generate merged string
str.Add key, key & "=" & params(key)
Next
newString = Join(str.Items, "") 'joining items
WScript.Echo newString
'normalize params' keys
For Each key In params
If Left(key, 1) = "|" Or Left(key, 1) = "#" Then
params.Key(key) = Mid(key, 2)
End If
Next
'lookup for `dnProjectsSendReport` parameter
WScript.Echo params("dnProjectsSendReport") 'must print 3
I find a solution:
'target = "projects#param1={param1}|param2={param2}#workplans#param3={param3}|param4={param4}..."
f_AccessArray = "projects#dnProjectsPatterning=0|dnProjectsSendReport=1#workplans#dnWorkplansAdd=0|dnWorkplansGrouping=1*projects#dnProjectsPatterning=1|dnProjectsSendReport=3#workplans#dnWorkplansAdd=1|dnWorkplansGrouping=0*projects#dnProjectsPatterning=5|dnProjectsSendReport=1#workplans#dnWorkplansAdd=0|dnWorkplansGrouping=2"
arrAccessPack = Split(f_AccessArray,"*")
endString = Split(arrAccessPack(0),"#")
nArrString = ""
for i = 0 to UBound(endString)
if i < UBound(endString) then strHash = "#" else strHash = ""
part1 = Split(endString(i),"#")(0)
part2 = Split(Split(endString(i),"#")(1),"|")
newParams = ""
for j = 0 to UBound(part2)
if j < UBound(part2) then strPipe = "|" else strPipe = ""
param = Split(part2(j),"=")(0)
newParams = newParams & param&"={"¶m&"}" & strPipe
next
nArrString = nArrString & part1&"#"&newParams & strHash
next
MergeAccessArray = MergerParams(f_AccessArray,nArrString)
Function MergerParams(fStr,fTarget)
Set dict = CreateObject("Scripting.Dictionary")
Set re = New RegExp
re.Global = True
re.Pattern = "(\w+)=(\d+)"
Set matches = re.Execute(fStr)
for each match in matches
key = match.Submatches(0)
value = cint(match.Submatches(1))
If dict.Exists(key) Then
If value < dict.Item(key) then
value = dict.Item(key)
End If
End If
dict.Item(key) = value
next
target = fTarget
for each key in dict
target = Replace(target, "{" & key & "}", dict.Item(key))
Next
MergerParams = target
End Function
Ok so now I'm not getting an error but instead of everything being posted in the listbox it only contains the first line of text from the .txt file. This is the code I changed it too:
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim inFile As IO.StreamReader
If IO.File.Exists("StudentList.txt") = True Then
inFile = IO.File.OpenText("StudentList.txt")
For index As Integer = 0 To inFile.Peek = -1
Dim splits = inFile.ReadLine.Split(","c)
Member(index).ID = splits(0)
Member(index).lastName = splits(1)
Member(index).firstName = splits(2)
Member(index).middleName = splits(3)
Member(index).grade = splits(4)
Member(index).period = splits(5)
ListBox1.Items.Add(Member(index).ID.PadLeft(10) & " " & Member(index).lastName & " " & Member(index).firstName)
Next
inFile.Close()
Else
MessageBox.Show("error", "error", MessageBoxButtons.OK)
End If
End Sub
The problem is that you're trying to assign a string array to a Member. That is, you have:
Member(index) = infile.ReadLine.Split(",", c);
You need to assign each field:
Dim splits = infile.ReadLine.Split(",", c);
Member(index).ID = splits(0);
Member(index).lastName = splits(1);
... etc.
Update after OP edit
I suspect the problem now is that your For loop is executing only once, or index isn't being incremented. I don't know where you came up with that wonky infile.Peek = -1 thing, but I suspect it doesn't work the way you think it does. Use something more conventional, like this.
Dim index As Integer = 0
For Each line As String In File.ReadLines("StudentList.txt")
Dim splits = line.Split(",", c)
Member(index).ID = splits(0)
' etc.
ListBox1.Add(...)
Index = Index + 1
Next
While I'm expecting a first and a last name as input for a vbscript I'm writing, sometimes the data will have both in a last name field, or it may contain a middle name as well. The separations between these could be commas or spaces. The data is pulled from an HL7 message.
The working method I'm using now is as follows:
Dim sLastName, sFirstName, sName, aName
sLastName = m.Element("PID-5-1").AsString
sFirstName = m.Element("PID-5-2").AsString
if sFirstName = "" then
sName = fixName(sLastName)
aName = split(sName, "*")
sLastName = aName(0)
sFirstName = aName(1)
end if
m.Element("PID-5-1").AsString = sLastName
m.Element("PID-5-1").AsString = sFirstName
'...rest of script, then fixName function...
Function fixName(sName)
sName = LTrim(sName)
sName = RTrim(sName)
sName = replace(sName, ",", "*")
sName = replace(sName, " ", "*")
sName = replace(sName, "**", "*")
fixName = sName
End Function
So this works, but it seems a bit inelegant. The script is already on the long side, and I have to perform this clean up in many places. I'm wondering if there is a way for me to perform the split in fixName() and return each part more directly? I tried sending a position variable to the function and then sending the appropriate array element based on that position, but I get an "subscript out of range" error when I do the split in fixName().
Ideally, I'd like to be able to write something in the if statement like:
sFirstName = fixName(sLastName,1)
sLastName = fixName(sLastName,0)
How would you do it, or is what I have the best I can hope for?
To show that such a function 'works':
>> Function getNamePart(s, i) : getNamePart = Split(s)(i) : End Function
>> s = "Alpha Beta Gamma"
>> WScript.Echo getNamePart(s, 0)
>> WScript.Echo getNamePart(s, 1)
>> WScript.Echo getNamePart(s, 2)
>>
Alpha
Beta
Gamma
and to demonstrate that you shouldn't use it - your CPU will hate you, if you force her to do the Split() (and the cleaning I left off) three times for one person.