I have two user-defined Excel Functions that work independently, but when I combined them with an Optional Argument, part of it no longer works.
The Functions I am testing are as follows:
Function PageWidth1()
Function PageWidth2(MyArea As Range)
Function PageWidth3(Optional MyArea As Range)
Their code is as follows:
Function PageWidth1()
Dim r As Range
Application.Volatile
Set r = Application.Caller.Parent.Range(Application.Caller.Parent.PageSetup.PrintArea)
Debug.Print r.Width
PageWidth1 = r.Width
End Function
And
Function PageWidth2(MyArea As Range)
Dim r As Range
Application.Volatile
Set r = Range(MyArea.Address)
Debug.Print r.Width
PageWidth2 = r.Width
End Function
And
Function PageWidth3(Optional MyArea As Range)
Dim r As Range
Application.Volatile
If Not (IsMissing(MyArea)) Then
Set r = Range(MyArea.Address)
Debug.Print r.Width
PageWidth3 = r.Width
Else
Set r = Application.Caller.Parent.Range(Application.Caller.Parent.PageSetup.PrintArea)
Debug.Print r.Width
PageWidth3 = r.Width
End If
End Function
= PageWidth1(), PageWidth2(MyRange), and PageWidth3(MyRange) all produce valid results.
= PageWidth3() produces and error.
Where am I going wrong?
The variable, which is a requested range, needed to be defined as a String rather than Range.
Related
I cant understand about the difference between Function and Sub procedures in VB.NET.
The one with Function :
Private Function remainder (intno1 As Integer, intno2 As _ Integer) As Integer
Dim intresult As Integer
intresult = intno1 Mod intno2
remainder = intresult
End Function
and then by this way i call it :
Private Sub cmdrem _Click()
Dim intm As Integer, intn As Integer
Dim intmod As Integer
intm = Val (txtno1.Text)
intn = Val (txtno2.Text)
intmod = remainder (intm, intn)
lblres.text = "Answer Is = " + Str(intmod)
End Sub
would you please help me ?
some main differences between procedure and function in vb are that the function returns a value but sub procedure never returns value.
the return type must be defined in function declaration.
A function always is declared with keyword Function and a sub procedure is declared with keyword Sub.
Function ends with the keyword end function
and procedure ends with keyword end sub.
I have a huge file containing values with a regex in it, like this:
LGP0041_\d{4}\.dta
objd135a_\S{3}.txt
Now I need to convert these to a valid example value, like this:
LGP0041_1234.dta
objd135a_abc.txt
I know of the RegExp object to check if there is a match, but is there also a way to create valid values?
A regular grammar can be used to recognize or produce words of its language, but the VBScript regexp engine does not implement producing. So you have to roll your own.
Your sample does not contain contain regular patterns. \S can't mean 'non-whitespace' because you won't like characters illegal in a file name and a representative sample of file names should contain elements with spaces. The fact that the first sample escapes the extension dot and the second one doesn't makes me think that your syntax specs aren't really thought out. If you come up with a (regular) grammar of your inputs, I'm willing to give your problem further thought.
Some code to base the thinking on:
Option Explicit
Function rndInt(lowerbound, upperbound)
rndInt = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
End Function
Sub shuffleAD(aX)
' Durstenfeld's Permutation Algorithm
Dim J, K, Temp
For J = UBound(aX) To 1 Step -1
K = Int((J + 1) * Rnd) ' random number 0 - J
Temp = aX(J)
aX(J) = aX(K)
aX(K) = Temp
Next
End Sub ' shuffleAD
Class cRGen
Private m_
Public Function init(s)
Set init = Me
ReDim m_(Len(s) - 1)
Dim i
For i = 0 To UBound(m_)
m_(i) = Mid(s, i + 1, 1)
Next
End Function
Public Function getNext(mi, ma)
shuffleAD m_
getNext = Mid(Join(m_, ""), 1, rndInt(mi, ma))
End Function
End Class
Dim goRpl : Set goRpl = Nothing
Function magic(m, w, mi, ma, p, src)
If IsEmpty(ma) Then ma = mi
magic = goRpl.m_dicGens(w).getNext(mi, ma)
End Function
Class cRpl
Private m_fRpl
Private m_r
Public m_dicGens
Private Sub Class_Initialize()
Set m_fRpl = GetRef("magic")
Set m_r = New RegExp
m_r.Pattern = "\\(\w){(\d+)(?:,(\d+))?}"
Set m_dicGens = CreateObject("Scripting.Dictionary")
Set m_dicGens("d") = New cRGen.init("0123456789")
Set m_dicGens("S") = New cRGen.init("abcdefghij")
End Sub
Public Function rpl(s)
Set goRpl = me
rpl = m_r.Replace(s, m_fRpl)
End Function
End Class
Randomize
Dim aTests : aTests = Array( _
"LGP0041_\d{4}.dta" _
, "objd135a_\S{3}.txt" _
, "x_\S{3,8}.txt" _
)
Dim oRpl : Set oRpl = New cRpl
Dim sTest
For Each sTest In aTests
WScript.Echo sTest, "=>", oRpl.rpl(sTest)
Next
output:
cscript 28936688.vbs
LGP0041_\d{4}.dta => LGP0041_4317.dta
objd135a_\S{3}.txt => objd135a_cea.txt
x_\S{3,8}.txt => x_jgcfidh.txt
cscript 28936688.vbs
LGP0041_\d{4}.dta => LGP0041_8054.dta
objd135a_\S{3}.txt => objd135a_eci.txt
x_\S{3,8}.txt => x_ahfgd.txt
This should at least identify the needed components:
generators that deliver strings of specific character sets
a (sorry: global) replace function that maps 'type letters' to generators, handles 'width specs', and build the output
a regular pattern to parse the specs from your inputs
Hi I'm having trouble with a simple while loop in vbscript.
I've got a Function which splits a string of e-mail addresses based on ";" it then runs each e-mail address through another function (isValidEmail) which does some simple validation checks with a Boolean return.
If any of the "isValidEmail" functions return false I want this "EmailSplitFunc" to return false and exit otherwise I want the whole thing to return true.
I've got the splitting function but I'm struggling to get a While loop in which works. Any ideas?
Function EmailSplitFunc(emailaddress)
Dim EmailSplitArray, i,
EmailSplitArray = split(EmailStudentCheck,";")
While isValidEmail(EmailStudentCheck)
For i = 0 To Ubound(EmailSplitArray)
EmailStudentCheck = EmailSplitArray(i)
isValidEmail(EmailStudentCheck)
Next
Wend
End function
Start with top-level code that tests the (to be written) checkMList() function:
Option Explicit
Dim aTests : aTests = Array( _
"a#b.com;nix" _
, "a#b.com;c#d.com" _
)
Dim sMList
For Each sMList in aTests
Dim bOk : bOk = checkMList(sMList)
WScript.Echo CStr(bOk), sMList
Next
and add a fake checkM() function:
Function checkM(sM)
checkM = 0 <> InStr(sM, "#")
End Function
Then consider checkMList(): It has to split the sMList and check each part for being a valid email; finding the first failure, the function should return False, only if all parts pass the check, True should be returned. This translates to:
Function checkMList(sMList)
Dim sM
For Each sM In Split(sMList, ";")
Dim bOk : bOk = checkM(sM)
WScript.Echo "*", CStr(bOk), sM
If Not bOk Then
checkMList = False ' first failure
Exit Function
End If
Next
checkMList = True ' reached if all ok
End Function
output:
* True a#b.com
* False nix
False a#b.com;nix
* True a#b.com
* True c#d.com
True a#b.com;c#d.com
I think you only need one loop..
For i = 0 to Ubound(EmailSplitArray)
If isValidEmail(EmailSplitArray[i]) = False Then
// Return False
End If
Next
I want to reduce the decimal length
text1.text = 2137.2198231578
From the above, i want to show only first 2 digit decimal number
Expected Output
text1.text = 2137.21
How to do this.
Format("2137.2198231578", "####.##")
I was about to post use Format() when I noticed p0rter comment.
Format(text1.text, "000.00")
I guess Int() will round down for you.
Been many years since I used VB6...
This function should do what you want (inline comments should explain what is happening):
Private Function FormatDecimals(ByVal Number As Double, ByVal DecimalPlaces As Integer) As String
Dim NumberString As String
Dim DecimalLocation As Integer
Dim i As Integer
Dim LeftHandSide As String
Dim RightHandSide As String
'convert the number to a string
NumberString = CStr(Number)
'find the decimal point
DecimalLocation = InStr(1, NumberString, ".")
'check to see if the decimal point was found
If DecimalLocation = 0 Then
'return the number if no decimal places required
If DecimalPlaces = 0 Then
FormatDecimals = NumberString
Exit Function
End If
'not a floating point number so add on the required number of zeros
NumberString = NumberString & "."
For i = 0 To DecimalPlaces
NumberString = NumberString & "0"
Next
FormatDecimals = NumberString
Exit Function
Else
'decimal point found
'split out the string based on the location of the decimal point
LeftHandSide = Mid(NumberString, 1, DecimalLocation - 1)
RightHandSide = Mid(NumberString, DecimalLocation + 1)
'if we don't want any decimal places just return the left hand side
If DecimalPlaces = 0 Then
FormatDecimals = LeftHandSide
Exit Function
End If
'make sure the right hand side if the required length
Do Until Len(RightHandSide) >= DecimalPlaces
RightHandSide = RightHandSide & "0"
Loop
'strip off any extra didgits that we dont want
RightHandSide = Left(RightHandSide, DecimalPlaces)
'return the new value
FormatDecimals = LeftHandSide & "." & RightHandSide
Exit Function
End If
End Function
Usage:
Debug.Print FormatDecimals(2137.2198231578, 2) 'outputs 2137.21
Looks fairly simple, but I must be missing something subtle here. What about:
Option Explicit
Private Function Fmt2Places(ByVal Value As Double) As String
Fmt2Places = Format$(Fix(Value * 100#) / 100#, "0.00")
End Function
Private Sub Form_Load()
Text1.Text = Fmt2Places(2137.2198231578)
End Sub
This also works in locales where the decimal point character is a comma.
I have a function which should calculate the sum in an array of cells. This function is called in another subroutine very often and therefore has to be real fast. First I used a for-loop to get the numbers but it was too slow. Then I wanted to use a worksheetfunction but this is not working for reasons unknown. Here is the code of the function:
Function CalcMD(rownumbers, colnumber)
Dim MMDRow As Integer
Dim SearchRange As String
Dim FirstAddress As Boolean
MMDRow = MMDRow()
FirstAddress = False
SearchRange = ""
'building the search range
For i = 0 To UBound(rownumbers)
If rownumbers(i) > 0 And rownumbers(i) < MMDRow Then
If FirstAddress = False Then
SearchRange = SearchRange & cells(rownumbers(i), colnumber).Address(False, False)
FirstAddress = True
Else
SearchRange = SearchRange & ";" & cells(rownumbers(i), colnumber).Address(False, False)
End If
End If
Next
CalcMD = WorksheetFunction.Sum(Range(SearchRange))
End Function
Is there a better/faster way to get this result?
Here is a try. The trickiest part is finding the last row you want to sum, I think this is where we should work if this first attempt doesn't solve your case.
Function CalcMD(rownumbers, colnumber)
Dim MMDRow As Integer, iMaxRow As Integer
Dim SearchRange As String
MMDRow = MMDRow()
'Find the last row where you want to sum the data
iMaxRow = WorksheetFunction.Min(MMDRow - 1, WorksheetFunction.Max(rownumbers))
CalcMD = WorksheetFunction.Sum(Cells(iMaxRow, colnumber))
End Function
Please also note that there aren't many error checking here (especially to check the input data)
Using JMax's approach:
Function CalcMD(rownumbers, colnumber)
Dim MMDRow As Integer, iMaxRow As Integer
Dim SearchRange As String
MMDRow = MMDRow()
'Find the last row where you want to sum the data
iMaxRow = WorksheetFunction.Min(MMDRow - 1, WorksheetFunction.Max(rownumbers))
CalcMD = WorksheetFunction.SumIF(Cells(iMaxRow, colnumber),">0")
End Function
Is that what you are looking for?