VBScript: How to select text after 6th occurence of char? - vbscript

I have this string:
0|1|2|3|4|5|6|7|8|9
I need to return the text after the 6th occurence of | and before the 7th. In this example, it would be 6.
Can his be achieved using the simple String functions (Mid, Left, Right, InStr)?

In addition, you could use a RegExp to look for the possibly empty sequence of non-| before a | and after 6 such sequences:
>> Set r = New RegExp
>> r.Pattern = "^(?:[^\|]*\|){6}([^\|]*)\|"
>> WScript.Echo r.Execute("0|1|2|3|4|5|6|7|8|9")(0).SubMatches(0)
>>
6
For production code, you'd need a check against non-confirming data.

s = "0|1|2|3|4|5|6|7|8|9"
For i = 1 To 6
intPos1 = InStr(intPos1 + 1, s, "|")
If intPos1 = 0 Then Exit For
Next
If intPos1 > 0 Then
intPos2 = InStr(intPos1 + 1, s, "|")
If intPos2 > intPos1 Then MsgBox Mid(s, intPos1 + 1, intPos2 - intPos1 - 1)
End If
Or, like #Filburt said, it could be a one-liner with Split():
MsgBox Split(s, "|")(6)

Dim s, c, n, i, p, e, r
s = "0|1|2|3|4|5|6|7|8|9" ' examined string
c = "|" ' split char
n = 6 ' occurance to start from
i = 0
p = 0
r = ""
Do
p = InStr(p + 1, s, c)
If p = 0 Then Exit Do
i = i + 1
If i = n Then
e = InStr(p + 1, s, c)
If e > 0 Then r = Mid(s, p + 1, e - p - 1)
Exit Do
End If
Loop
MsgBox r

Related

Visual Studio - Printing "X" with Coordinates

I need your help with the coordinates. What I would like to happen is to print an "X" after the given coordinates. Example: The given coordinates for x-axis is 2 and y-axis is 2
the output will be:
So basically, 2 "#" on the top and 2 "#" on the left, then it will print the letter "X"
Dim d As String = ""
For i = 0 To NumericUpDownX.Value
For j = 0 To NumericUpDownY.Value
d = d & "#"
Next
d = d & vbNewLine
Next
output.Text = d
I was able to print the # but I can't seem to figure out how to put the "X" there.
I'd do it like this with the String constructor and PadLeft:
Dim d As New System.Text.StringBuilder
For y = 0 To NumericUpDownY.Value
If y < NumericUpDownY.Value Then
d.AppendLine(New String("#", NumericUpDownX.Value + 1))
Else
d.AppendLine("X".PadLeft(NumericUpDownX.Value + 1, "#"))
End If
Next
output.Text = d.ToString
If you want something more inline with what you were originally doing, then:
Dim d As String = ""
For y = 0 To NumericUpDownY.Value
For x = 0 To NumericUpDownX.Value
If y = NumericUpDownY.Value AndAlso x = NumericUpDownX.Value Then
d = d & "X"
Else
d = d & "#"
End If
Next
d = d & vbCrLf
Next
output.Text = d

How to capitalise a random letter?

In VBScript is it possible to select a random letter and capitalize it until all letters have been capitalized at least once?
Dim a
a = "Hello"
For i=o To Len(a)-1
If Mid(a,i+1, 1) = Mid(a, i+1, 1) Then
b = Mid(a, i+1, 1)
MsgBox b
End If
Next
That's some code I gathered. So far it reads a string letter by letter.
I want the output to be something like:
hello
Hello
hEllo
etc.
but I can't see how to do it without getting into super complex Mid Left Right statements that become confusing. Is it possible? Or do I need to use something like Mid(LCase(s,1,1) & Mid(UCase(s,2,1)) & Mid(LCase(s,3,3)?
Use Len() to determine the positions of letters to capitalize and Left() + UCase(Mid()) + Mid() to actually uppercase the letter at p =
Option Explicit
Dim s : s = "hello"
Dim l : l = Len(s)
Dim i : i = 0
Do Until s = UCase(s)
Dim p : p = Fix(Rnd() * l) + 1
If Mid(s, p, 1) <> UCase(Mid(s, p, 1)) Then s = Left(s, p - 1) & UCase(Mid(s, p, 1)) & Mid(s, p + 1)
WScript.Echo i, p, s
i = i + 1
Loop
output:
cscript 52911013.vbs
0 4 helLo
1 3 heLLo
2 3 heLLo
3 2 hELLo
4 2 hELLo
5 4 hELLo
6 1 HELLo
7 4 HELLo
8 5 HELLO

Read the quantity of carriage return used in Word

I am calculating accuracy from a word document by calculating the total number of changes made once track review is on. Incorrect use of punctuation is calculated as 1/4 mark, while for contextual or grammar errors a full 1 mark is deducted.
Right now all carriage returns are being calculated as 1 full mark. I want this either to be removed completely or can pass it along as 1/4 mark deduction. I am using the following for counting . ; and , as 1/4 mark deduction.
For Each myRevision In ActiveDocument.Revisions
myRevision.Range.Select
If myRevision.Type = wdRevisionInsert Then
lngRevisions = Len(Selection.Text)
For i = 1 To lngRevisions
If Mid(Selection.Text, i, 1) = "," Then
punct = punct + 1
Else
End If
If Mid(Selection.Text, i, 1) = "." Then
punct = punct + 1
Else
End If
If Mid(Selection.Text, i, 1) = ";" Then
punct = punct + 1
Else
End If
If Mid(Selection.Text, i, 1) = "" Then
punct = punct + 1
Else
End If
Next i
Count = Count + 1
Else
End If
Next
tCorrections = Count + punct * 0.25 - punct
Accuracy = ((tWords - tCorrections) / tWords) * 100
Accuracy = Round(Accuracy, 1)
Use an array of types names (aLabels) and a string of the types occurring in your data (sC) via a mapping (aMap) of types to counting slots for a flexible way to classify your string(s). As in this demo:
Option Explicit
Dim aLabels : aLabels = Split("Vowels Consants Digits Punctuations EOLs Unclassified")
ReDim aCounts(UBound(aLabels))
Dim sC : sC = "abce1,2." & vbCr
Dim aMap : aMap = Array(0, 1, 1, 0, 2, 3, 2, 3, 4)
Dim sD : sD = sC & "d" & sC & "bb111."
Dim p, i
For p = 1 To Len(sD)
i = Instr(sC, Mid(sD, p, 1))
If 0 = i Then
i = UBound(aLabels)
Else
i = aMap(i - 1)
End If
aCounts(i) = aCounts(i) + 1
Next
For i = 0 To UBound(aLabels)
WScript.Echo Right(" " & aCounts(i), 3), aLabels(i)
Next
output:
cscript 42505210.vbs
4 Vowels
6 Consants
7 Digits
5 Punctuations
2 EOLs
1 Unclassified
Based on such raw data (frequencies of types) you an add specials weights.
Update wrt comment:
As I said: Add weights after calculating the raw frequencies:
... as above ...
Dim nSum
' Std - all weights = 1
nSum = 0 : For Each i In aCounts : nSum = nSum + i : Next
WScript.Echo "all pigs are equal:", nSum
' No EOLs
nSum = 0 : For Each i In aCounts : nSum = nSum + i : Next : nSum = nSum - aCounts(4)
WScript.Echo "EOLs don't count:", nSum
nSum = 0 : aCounts(0) = aCounts(0) * 4 : For Each i In aCounts : nSum = nSum + i : Next
WScript.Echo "vowels count * 4:", nSum
additional output:
all pigs are equal: 25
EOLs don't count: 23
vowels count * 4: 37

Converting a number to normalized scientific notation

I'm trying to create a method converting a number to normalized scientific notation, here is the code that I'm using to calculate mantissa and exponent:
ConvNSN 1000, M, P
MsgBox M & "e" & P
Sub ConvNSN(N, M, P)
If N = 0 Then
P = 0
M = 0
Else
P = Int(Log(Abs(N)) / Log(10))
M = N / 10 ^ P
End If
End Sub
The problem I am facing is that this code gives wrong exponent value for some numbers, eg 1000, 10E+6, 10E+9, 10E+12, 10E+13, etc... Exactly for 1000 converted should be 1e3, but not 10e2. It's obvious that the same problem with numbers, whose logarithms are close to an integer value, like Log(1 - 5.55111512312578E-17) / Log(10), which result is 0, however 1 - 5.55111512312578E-17 less then 1, and result has to be negative.
How can I get rid of Double type imprecision, and get this code to work properly?
UPDATE
I assume the fastest and quite accurate method to calculate mantissa and exponent of number in normalized scientific notation may be as follows:
Sub ConvNSN(N, M, P)
Dim A
If N = 0 Then
P = 0
M = 0
Exit Sub
End If
A = Abs(N)
If A < 1 Then
P = Int(Log(A) / Log(10))
Else
P = Int(Log(A) / Log(10) * (2 + Log(.1) / Log(10)))
End If
M = N / 10 ^ P
End Sub
Or another one, based on #Bob's solution:
Sub ConvNSN(N, M, P)
If N = 0 Then
P = 0
M = 0
Else
P = Int(Log(Abs(N)) / Log(10))
M = N / 10 ^ P
End If
If Abs(M) = "10" Then
M = M / 10
P = P + 1
End If
End Sub
First one slightly faster. Both of them process exponent from -322 to 308, but return not normalized mantissa with powers of 10 less then -310. I have not tested them yet with numbers, whose logarithms are a marginally less but very close to an integer values.
UPDATE 2
I decided to attach here an extra Sub ConvEN(), allowing to represent a number in engineering notation with SI prefixes from "p" to "T":
N = .0000456789
ConvNSN N, M, P
M = Round(M, 2)
ConvEN M, P, R, S
MsgBox R & " " & S & "Units"
Sub ConvNSN(N, M, P)
Dim A
If N = 0 Then
P = 0
M = 0
Exit Sub
End If
A = Abs(N)
If A < 1 Then
P = Int(Log(A) / Log(10))
Else
P = Int(Log(A) / Log(10) * (2 + Log(.1) / Log(10)))
End If
M = N / 10 ^ P
End Sub
Sub ConvEN(M, P, R, S)
DIM Q, P3
Q = int(P / 3)
P3 = Q * 3
If Q >= -4 And Q <= 4 Then
S = Array("p", "n", ChrW(&H03BC), "m", "", "k", "M", "G", "T")(Q + 4)
Else
S = "e" & P3 & " "
End If
R = M * 10 ^ (P - P3)
End Sub
Try this:
ConvNSN 1000, M, P
MsgBox M & "E" & P
ConvNSN 0.00000000000000001234, M, P
MsgBox M & "E" & P
ConvNSN -0.00000000000000001234, M, P
MsgBox M & "E" & P
Sub ConvNSN(N, M, P)
P = 0
If N < 0 Then
S = -1
ElseIf N > 0 Then
S = 1
Else
M = 0
Exit Sub
End If
M = Abs(N)
If M >= 10 Then
While M >= 10
M = M / 10
P = P + 1
Wend
M = M * S
Exit Sub
End If
If M < 1 Then
While M < 1
M = M * 10
P = P - 1
Wend
M = M * S
Exit Sub
End If
End Sub
Based on the comments, I re-wrote this my way, ignoring the structure from the OP.
MsgBox NSN(-0.0000000000000000000123456789,4)
MsgBox NSN(1234567890000000000000000000,4)
Function NSN(Number, Accuracy)
Exponent = 0
If Number > 0 Then
Sign = 1
ElseIf Number < 0 Then
Sign = -1
Else
NSN = 0
Exit Function
End If
Number = Number * Sign
If Number >= 10 Then
While Number >= 10
Number = Number / 10
Exponent = Exponent + 1
Wend
ElseIf Number < 1 Then
While Number < 1
Number = Number * 10
Exponent = Exponent - 1
Wend
End If
Number = Round(Number, Accuracy)
If Number = "10" Then
Number = 1
Exponent = Exponent + 1
End If
Number = Number * Sign
If Exponent = 0 Then
NSN = Number
Else
NSN = Number & "E" & Exponent
End If
End Function
Using strings rather than maths can help. Add your own error checking.
Num = "1000000.0005"
NumOfDigits = 4
Mag = Instr(Num, ".")
Num = Replace(Num, ".", "")
MSD = Left(Num, 1)
Rest = Mid(num, 2, NumOfDigits)
msgbox MSD & "." & Rest & " x 10^" & (Mag -2)

Magic square error in visual basic 6.0

I'm developing a program in visual basic 6.0 to display magic square. I've developed the logic, but the values are not getting displayed in the magic square. Here's the code :
Private Sub Command1_Click()
Dim limit As Integer
Dim a(100, 100) As Integer
limit = InputBox("Enter the limit")
If limit Mod 2 = 0 Then ' Rows and columns must be
MsgBox "Can't be done", vbOKCancel, "Error"
Else ' set number of rows and columns to limit
mfgsquare.Rows = limit
mfgsquare.Cols = limit
j = (n + 1) / 2
i = 1
For c = 1 To n * n
mfgsquare.TextMatrix(i, j) = c
If c Mod n = 0 Then
i = i + 1
GoTo label
End If
If i = 1 Then
i = n
Else
i = i - 1
End If
If j = n Then
j = 1
Else
j = j + 1
End If
label:
Next c
End If
End Sub
Try this:
n = InputBox("Enter the limit")
If n Mod 2 = 0 Then ' Rows and columns must be
MsgBox "Can't be done"
Else ' set number of rows and columns to limit
mfgsquare.Rows = n + 1
mfgsquare.Cols = n + 1
For i = 1 To n
For j = 1 To n
mfgsquare.TextMatrix(i, j) = n * ((i + j - 1 + Int(n / 2)) Mod n) + ((i + 2 * j - 2) Mod n) + 1
Next j
Next i
End If

Resources