String reverse in VB Script without using Built in functions - string

option explicit
dim r, res, num
num= cint(inputbox("Enter the number"))
do while(num > 0)
r= num mod 10
num= num\10
res= res & r
loop
msgbox res
Well this is the code, now my question is this works perfectly fine for input 1234, well if the input is 0123 it just prints 321 which is wrong.It needs to print 3210.
I am unable to figure out, tried a lot but in vain, any help would be appreciated
Thanks and Regards

You must decide whether you want to reverse strings or numbers (accidentially represented as decimals). If you want to reverse strings, you should
not convert the (string) input to a number/integer
use string ops: Mid() for reading, concatenation & for building
Added: In (demo/not production) code:
Option Explicit
Function rev(s)
Dim p
For p = Len(s) To 1 Step -1
rev = rev & Mid(s, p, 1)
Next
End Function
Dim s
For Each s In Array("1234", "0123")
WScript.Echo s, rev(s)
Next
output:
1234 4321
0123 3210

str = Inputbox("Enter the number")
rev=""
Set regx = New RegExp
regx.Global = True
regx.IgnoreCase = True
regx.Pattern = ".{1}"
Set colchars= regx.Execute(str)
For i = 0 To colchars.Count-1
rev= colchars.Item(i)&rev
Next
MsgBox rev

String reverse program without using Reverse String function & Mid function.
str=inputbox("Enter the string: ")
str1=len(str)
a=Left(str,1)
for i=1 to str1
str2=Left(str,i)
if len(str2)>1 then
str3=Right(str2,1)&temp
temp=str3
end if
next
msgbox temp&a

Try this:
Dim num, rev
num = inputbox("Enter a number")
If Len(num)=4 Then
rev = rev*10 + num mod 10
num = num/10
num = left(num,3)
rev = rev*10 + num mod 10
num = num/10
num = left(num,2)
rev = rev*10 + num mod 10
num = num/10
num = left(num,1)
rev = rev*10 + num mod 10
msgbox "Reverse Order of the number is "&rev
Else
msgbox "Number, you entered is not a 4 digit number"
End If

Related

VBA replace a string EXCEL 2019

I cannot extract the postal/zip code of a given address cell that comes like this :
"108, avenue du Grand Sud 37 170 CHAMBRAY les TOURS".
I have used :
=RECHERCHE(9^9;--("0"&STXT(A2;MIN(CHERCHE({0.1.2.3.4.5.6.7.8.9};A2&"0 123456789"));LIGNE($1:$100))))
Which sometimes works, sometimes not depending on the street number starting the address (here "108,").
The problem is the space of the pattern "37 170". I would like to remove the blank space in the pattern. Is there a regex way to search this pattern "## ###", and then to remove this poisonous blank space?
Thank you for your tricks.
I have tried this piece of code :
Function toto(r, Optional u = 0)
Application.Volatile
Dim i%, j%, adr$, cp$, loca$, x
x = Split(r)
For i = 0 To UBound(x)
If x(i) Like "#####" Then Exit For
Next
If i > UBound(x) Then
adr = r.Value 'facultatif
Else
cp = x(i)
For j = 0 To i - 1: adr = adr & x(j) & " ": Next
adr = Left$(adr, Len(adr) + (Len(adr) > 1))
For j = i + 1 To UBound(x): loca = loca & x(j) & " ": Next
loca = Left$(loca, Len(loca) + (Len(loca) > 1))
End If
x = Array(adr, cp, loca)
If 0 < u And u < 4 Then toto = x(u - 1) Else toto = x
End Function
The above code works fine for splitting addresses including street number, zip code, and city name. But it does not work when the zip code is ## ### = 2 digit integer - space - 3 digit integer.
Edit: 01 June 2021
Since it seems my question is not clear enough, let's rephrase :
Given an Excel worksheet containing in each cell of column A, from saying A1 down to A10000, complete addresses like this one :
"2 rue Rene cassin Centre Commercial Châlon 2 Sud 71 100 CHALON SUR SAONE"
or this one :
"15, Rue Emile Schwoerer 68 000 COLMAR"
Where "71 100" and "68 000" are a zip code in incorrect format because of the extra space between the 2 first digits and 3 last digits.
I need to split the Ai cell content in order to obtain :
in cell Bi : the text (street, etc.) placed left before the 2 first digits of the "wrong" zip code,
in cell Ci : the zip code with its correct format ("71100" and not "71 100"),
in cell Di : the text (city name) after the zip code.
It's a kind of left and right extraction around the zip code.
The above code that I have posted does not work.
In order to obtain the correct zip code format, I have tried the regex following function :
Function FindReplaceRegex(rng As Range, reg_exp As String, replace As String)
Set myRegExp = New RegExp
myRegExp.IgnoreCase = False
myRegExp.Global = True
myRegExp.Pattern = reg_exp
FindReplaceRegex = myRegExp.replace(rng.Value, replace)
End Function
But I am unable to determine the correct regular expression pattern to get rid of the space in the zip code.
PEH gave me the following pattern :
(.*)([0-9]{2} ?[0-9]{3})(.*)
When using the function, I have tried to define the replacement pattern by:
(.*)([0-9]{2}[0-9]{3})(.*)
But it would not work. Hope this will clarify my question.
Any idea is welcome. Thanks
If these input strings always have the same pattern, try:
=CONCAT(FILTERXML("<t><s>"&SUBSTITUTE(A1," ","</s><s>")&"</s></t>","//s[.*0=0]"))
Depending on your needs/edge-cases, you could add more xpath expressions.
If this is VBA, I have a fix for you (please forgive the crappy naming convention, I'm scribbling this down in work while waiting for SQL to refresh):
Sub test1()
a0 = Cells(1, 1) 'Get the text, in this case "108, avenue du Grand Sud 37 170 CHAMBRAY les TOURS"
aa = Replace(a0, ",", " ") 'Make all delimiters of same type, so removing commas, you may need to add more replace work here?
ab = Application.Trim(aa) 'Reduce all whitespace to single entries, i.e. " " rather than " "
ac = Split(ab, " ", -1) 'Now split by that single whitespace entry
Dim txt()
i2 = 0
lastIsNumeric = False
For i1 = 0 To UBound(ac) - 1 'Step through each entry in our "split" list
If IsNumeric(ac(i1)) = True And IsNumeric(ac(i1 + 1)) = True Then
'Two numbers back to back, join
ReDim Preserve txt(i2)
txt(i2) = ac(i1) + ac(i1 + 1)
i2 = i2 + 1
i1 = i1 + 1
Else
'Not two numbers back to back, don't join
ReDim Preserve txt(i2)
txt(i2) = ac(i1)
i2 = i2 + 1
End If
Next i1
If IsNumeric(ac(UBound(ac))) = False Then
'Need to add last entry to txt()
ReDim Preserve txt(UBound(txt) + 1)
txt(UBound(txt)) = ac(UBound(ac))
End If
End Sub
edit 2021-06-01:
The above will generate a list (txt) of all the entries within your address. You can then reassemble if you wish, or extract out the postcode only.
If you want it as a function, then it would be:
Public Function getPostcode(a0)
aa = Replace(a0, ",", " ")
ab = Application.Trim(aa)
ac = Split(ab, " ", -1)
Dim txt()
i2 = 0
lastIsNumeric = False
For i1 = 0 To UBound(ac) - 1
If IsNumeric(ac(i1)) = True And IsNumeric(ac(i1 + 1)) = True Then
'Two numbers back to back, join
ReDim Preserve txt(i2)
txt(i2) = ac(i1) + ac(i1 + 1)
i2 = i2 + 1
i1 = i1 + 1
Else
'Not two numbers back to back, don't join
ReDim Preserve txt(i2)
txt(i2) = ac(i1)
i2 = i2 + 1
End If
Next i1
If IsNumeric(ac(UBound(ac))) = False Then
'Need to add last entry to txt()
ReDim Preserve txt(UBound(txt) + 1)
txt(UBound(txt)) = ac(UBound(ac))
End If
'Re-assemble string for return
rtnTxt = ""
For i1 = 0 To UBound(txt)
rtnTxt = rtnTxt & " " & txt(i1)
Next i1
getPostcode = rtnTxt
End Function

How to search for a word in a string in FreeBASIC

I am trying to create an internal function in my FreeBASIC program where i want to check for the word "echo" in the string variable "line0" and if "echo" is part of the string, i want it to echo the input (except "echo")
BASIC's Instr function can search through a string and find out if it contains a certain substring. It can do so starting at the first position of the string or any other position if we mention the value in the parameter list. The result that Instr returns is the character position of the find or else zero to denote that the substring was not found.
It's the optional mentioning of the start position that makes all the difference in writing an algorithm that has to find all occurences of a certain substring.
Once Start = 1 Position = Instr(Start, MyString, MySubString) has found the first substring, we can move the start position to just past the find and start over again. We keep doing so until the Instr function returns zero which tells us there are no more occurences of the substring.
Echo asked: What is this echo that echoes in my ear?
^ ^ ^ ^ ^ ^ ^
1 | | | | | |
+4 5 | | | | |
26 | | | |
+4 30 | | |
36 | |
+4 40 |
0 "Not found"
A function that prints its result directly
This SkipText function expects from 1 to 3 parameters. The second and third parameters are optional because of the mention of a default value in the parameter list.
param1 is the string to search (in)
param2 is the string to search for
param3 can limit the number of removals
Declare Function SkipText (a As String, b As String = "", c As Integer = 1) As Integer
Dim As String s
s = "Echo asked: What is this echo that echoes in my ear?"
Print "The function outputs directly"
Print " Unmodified: ";
SkipText(s)
Print " Modified*1: ";
SkipText(s, "echo", 1)
Print " Modified*2: ";
SkipText(s, "echo", 2)
Print " Modified*3: ";
SkipText(s, "echo", 3)
GetKey ' So you can inspect the output
Function SkipText (a As String, b As String, c As Integer) As Integer
Dim As Integer h, i, j, k
h = IIf(c < 1, 1, c) ' Guard against bogus input
i = 1
j = 1 + Len(a) - Len(b)
Do While i <= j
k = InStr(i, a, b) ' Case-sensitive
If k = 0 Then Exit Do
Print Mid(a, i, k-i);
i = k + Len(b)
h -= 1
If h = 0 Then Exit Do
Loop
Print Mid(a, i)
Return 0
End Function
A function that returns a string that the caller can then print
Next SkipText function expects from 1 to 3 parameters. The second and third parameters are optional because of the mention of a default value in the parameter list.
param1 is the string to search (in)
param2 is the string to search for
param3 can limit the number of removals
If you tried the above code snippet, you will have seen that the first "Echo", the one that starts with a capital, was not removed. This happens because FreeBasic's Instr always works 'case-sensitive'. The simple solution to remove in a 'case-insensitive' way is to use the UCase function like in:
Position = Instr(Start, UCase(MyString), UCase(MySubString))
Declare Function SkipText (a As String, b As String = "", c As Integer = 1) As String
Dim As String s
s = "Echo asked: What is this echo that echoes in my ear?"
Print "The function returns a (reduced) string"
Print " Unmodified: "; SkipText(s)
Print " Modified*1: "; SkipText(s, "echo", 1)
Print " Modified*2: "; SkipText(s, "echo", 2)
Print " Modified*3: "; SkipText(s, "echo", 3)
GetKey ' So you can inspect the output
Function SkipText (a As String, b As String, c As Integer) As String
Dim As String t = ""
Dim As Integer h, i, j, k
h = IIf(c < 1, 1, c) ' Guard against bogus input
i = 1
j = 1 + Len(a) - Len(b)
Do While i <= j
k = InStr(i, UCase(a), UCase(b)) ' Case-insensitive
If k = 0 Then Exit Do
t = t + Mid(a, i, k-i)
i = k + Len(b)
h -= 1
If h = 0 Then Exit Do
Loop
Return t + Mid(a, i)
End Function
() Because these are tiny code snippets, I wasted no time choosing sensible identifiers. In longer programs you should always pick meaningful names for any identifiers.
() FreeBasic comes with a nice, comprehensive manual. If anything isn't clear, first consult the manual, then maybe ask a question on this forum.
did you do any kind of research? Sorry, but I assume you did not.
The answer is, there is already a function for this task builtin in Basic language.
The function you are searching for is "INSTR". Please read the available documentation for FreeBasic. If you then decide to try to write your own INSTR function (if you need a feature which is not provided by the builtin function), try to do your coding, and if you stuck, we´ll try to help.
Your described task will therefore include the following functions:
INSTR ' check if the string is here
LEN ' to know the length of your search string
MID ' to create the 'reduced' output (maybe you will to have it used twice)

VBA generate a code

there. I made this code that replaces a character for two number (e.g. 0 = 10; 1 = 11; 2 = 12; ...) and everything works fine except for the first element (the zero element). So, if I put "010a4" string on cell A1 and use my formula "=GENERATECODE(A1)", my expected return value is "1011102014" but I've got a "110111102014" string. So, only zero value occur this error and I can't figured out why. Any thoughts?
My code:
Function GENERATECODE(Code As String)
Dim A As String
Dim B As String
Dim i As Integer
Const AccChars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const RegChars = "1011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071"
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, 2 * i - 1, 2)
Code = Replace(Code, A, B)
Next
GENERATECODE = Code
End Function
Your problem is that your code first change each 0 to 10 then each 1 to 11. So each 0 give you 10 then 110.
If you want to keep the same kind of algorithm (which might not be a good choice), you need to change AccChars and RegChars so that a character is never replaced by a string that can give a character found later on the AccChars String. In your case just replace Const AccChars = "012 ... per Const AccChars = "102 ... and Const RegChars = "101112 ... per Const RegChars = "111012 ...
But it might be better to change your algorithm altogether. I would first suggest to not use in place editing of the string, but rather to use 2 Strings.
In addition to being incorrect, your current code is inefficient since it involves scanning over the code string multiple times instead of just once. Simply scan over the string once, gathering the substitutions into an array which is joined at the end:
Function GENERATECODE(Code As String) As String
Dim codes As Variant
Dim i As Long, n As Long
Dim c As String
n = Len(Code)
ReDim codes(1 To n)
For i = 1 To n
c = Mid(Code, i, 1)
Select Case c
Case "0" To "9":
codes(i) = "1" & c
Case "a" To "z":
codes(i) = Asc(c) - 77
Case "A" To "Z":
codes(i) = Asc(c) - 19
Case Else:
codes(i) = "??"
End Select
Next i
GENERATECODE = Join(codes, "")
End Function
Example:
?generatecode("010a4")
1011102014
The point of the two offsets is that you want "a" to map to 20 and "A" to map to 46. Note Asc("a") - 77 = 97 - 77 and Asc("A") - 19 = 65-19 = 46.

Type mismatch when converting averages to grade (beginner)

I am taking a computer sciences class right now, and I just have no idea how to convert an average made from 3 scores to a letter grade. At first I thought I could do something like:
PRINT name$(c); TAB(6) ; USING("###.#", average(c))
As:
PRINT name$(c); TAB(6) ; USING("***something for text here***", average(c))
But after my searches and scouring on the internet, I came up with nothing. After a while I rewrote a majority of my code, but it still doesnt work correctly. Can someone tell me what I can do to get it working?
Here it is:
dim names(20)
dim average$(20)
x = 0
input "Please input Teacher's name:"; teacher$
rem teacher$
cls
input "Input student's name:"; studentname$
do while studentname$ <> ""
name$(x)=studentname$
rem name$(x)
input "Input first number:"; e
input "Input second number:"; f
input "Input third number:"; g
avg$=(e+f+g)/3
average(x)= avg
x=x+1
cls
input "Input the next name or press enter to finish:"; studentname$
loop
print teacher$; "'s Class Report"
for c = 1 to X
if (avg$>89 and avg$<101) then let avg= "A" else if
if (avg$>79 and avg$<89) then let avg= "B" else if
if (avg$>69 and avg$<79) then let avg= "C" else if
if (avg$>59 and avg$<69) then let avg= "D" else if
if (avg$<59) then let avg= "F"; print names(c), TAB(6) average$(c)
next c
end
Three thing to note here.
First off, the dollar sign $ is only used at the end of variablenames that contain text values not numeric values. So it's a$ = "hello" and i = (12+34+56) / 3 etc.
Secondly, in the input part you calculate the average value and store it in variable avg$. Then in the for-loop where you want to print the letter grades you check the same variable name. However, you never set avg$ within that for-loop, so it will always just contain the last calculated value. And also it should be without $ because it's a numeric value.
Finally, like Shawn Mehan also already commented, you should rename your variables to better reflect what they are used for. That will probably clear up some of the confusion. So something like dim avgpoint(20) for the 0-100 scores, and avgletter$="A" etc. for the letters grade.
So to combine these things, I would change your code to something like this:
input "Input first grade number (0-100):"; grade1
input "Input second grade number (0-100):"; grade2
input "Input third grade number (0-100):"; grade3
calcavg = (grade1+grade2+grade3)/3
avgpoint(x) = calcavg
and then
for c = 1 to x
p = avgpoint(x)
if (p>89 and p<=101) then let avgletter$ = "A"
'etc.
Here is some coding sample for a grade report program:
DIM Names(20) AS STRING
DIM Average(20) AS SINGLE
INPUT "Please input Teacher's name"; Teacher$
PRINT "Enter up to 20 names, <enter> to quit:"
DO UNTIL x = 20
PRINT "Input student"; x + 1; "name";
INPUT StudentName$
IF StudentName$ = "" THEN EXIT DO
x = x + 1: Names(x) = StudentName$
INPUT "Input first number"; J
INPUT "Input second number"; K
INPUT "Input third number"; L
Average(x) = (J + K + L) / 3
LOOP
PRINT Teacher$; "'s Class Report"
FOR c = 1 TO x
SELECT CASE Average(c)
CASE 0 TO 59
Grade$ = "F"
CASE 60 TO 69
Grade$ = "D"
CASE 70 TO 79
Grade$ = "C"
CASE 80 TO 89
Grade$ = "B"
CASE ELSE
Grade$ = "A"
END SELECT
PRINT Names(c); SPC(6); Grade$
NEXT
END
Another coding sample of a grade report program with variable number of scores:
DIM Names(20) AS STRING
DIM Average(20) AS SINGLE
INPUT "Please input Teacher's name"; Teacher$
PRINT "Enter up to 20 names, <enter> to quit:"
DO UNTIL x = 20
PRINT "Input student"; x + 1; "name";
INPUT StudentName$
IF StudentName$ = "" THEN EXIT DO
x = x + 1: Names(x) = StudentName$
y = 0 ' number of scores
z = 0 ' total of scores
PRINT "Enter scores, <enter> to quit:"
DO
PRINT "Enter score"; y + 1;
INPUT I$
IF I$ = "" THEN EXIT DO
IF VAL(I$) >= 0 AND VAL(I$) <= 100 THEN
y = y + 1
z = z + VAL(I$)
ELSE
PRINT "Value must be 0 to 100."
END IF
LOOP
IF y > 0 THEN ' avoid division by zero
Average(x) = z / y
END IF
LOOP
PRINT Teacher$; "'s Class Report"
FOR c = 1 TO x
SELECT CASE Average(c)
CASE 0 TO 59
Grade$ = "F"
CASE 60 TO 69
Grade$ = "D"
CASE 70 TO 79
Grade$ = "C"
CASE 80 TO 89
Grade$ = "B"
CASE ELSE
Grade$ = "A"
END SELECT
PRINT Names(c); SPC(6); Grade$
NEXT
END

Lpad with zero's in vbscript

I'm trying to pad a string with 0's to the left.The length of the output string should be 7.
Here's my code :
inputstr = "38"
in = string(7 - Len(inputStr),0) & inputStr
msgbox in
I'm getting error Expected Statement
Please help me
Thank You
The following code will run 5% faster:
inputStr = "38"
result = Right("0000000" & inputStr, 7)
msgbox result
This function will left-pad an input value to the given number of characters using the given padding character without truncating the input value:
Function LPad(s, l, c)
Dim n : n = 0
If l > Len(s) Then n = l - Len(s)
LPad = String(n, c) & s
End Function
Output:
>>> WScript.Echo LPad(12345, 7, "0")
0012345
>>> WScript.Echo LPad(12345, 3, "0")
12345
in is a reserved word so can't be used as a variable name and you must pass a string "0" not an integer 0, so:
inputStr = "38"
result = string(7 - Len(inputStr), "0") & inputStr
msgbox result
Function:
Private Function LPad (str, pad, length)
LPad = String(length - Len(str), pad) & str
End Function
Use:
LPad(12345, "0", 7)

Resources