I am getting a compile error in Excel VBA which says Expected Sub, Function or Property. The function I am using is given below which is trying to copy the rate function in Excel.
Thanks for your help.
Function rate_m(nper As Double, pmt As Double, pv As Double, fv As Double, types As Double, guess As Double) As Variant
Dim y, y0, y1, x0, x1, f, i As Double
Dim FINANCIAL_MAX_ITERATIONS As Double
Dim FINANCIAL_PRECISION As Double
If IsNull(guess) Then guess = 0.01
If IsNull(fv) Then fv = 0
If IsNull(types) Then types = 0
FINANCIAL_MAX_ITERATIONS = 128 'Bet accuracy with 128
FINANCIAL_PRECISION = 0.0000001 '1.0e-8
y , y0, y1, x0, x1, f, i = 0
rate_m = guess
If Abs(rate_m) < FINANCIAL_PRECISION Then
y = pv * (1 + nper * rate_m) + pmt * (1 + rate_m * types) * nper + fv
Else
f = Exp(nper * Log(1 + rate_m))
y = pv * f + pmt * (1 / rate_m + types) * (f - 1) + fv
y0 = pv + pmt * nper + fv
y1 = pv * f + pmt * (1 / rate_m + types) * (f - 1) + fv
End If
'find root by Newton secant method
i , x0 = 0
x1 = rate_m
While Abs(y0 - y1) > FINANCIAL_PRECISION & i < FINANCIAL_MAX_ITERATIONS
rate_m = (y1 * x0 - y0 * x1) / (y1 - y0)
x0 = x1
x1 = rate_m
If Abs(rate_m) < FINANCIAL_PRECISION Then
y = pv * (1 + nper * rate_m) + pmt * (1 + rate_m * types) * nper + fv
Else
f = Exp(nper * Log(1 + rate_m))
y = pv * f + pmt * (1 / rate_m + types) * (f - 1) + fv
End If
y0 = y1
y1 = y
i = i + 1
Wend
End Function
Фазли 2 / 1 / 0 Регистрация: 07.10.2018 Сообщений: 172 |
|||||||||
1 |
|||||||||
02.12.2018, 07:17. Показов 3603. Ответов 1 Метки нет (Все метки)
0 |
1836 / 1152 / 353 Регистрация: 11.07.2014 Сообщений: 4,071 |
|
02.12.2018, 08:00 |
2 |
Сообщение было отмечено Фазли как решение Решение
j -j + 1 думаю, должно быть j = j+1
1 |
Permalink
Cannot retrieve contributors at this time
title | keywords | f1_keywords | ms.prod | ms.assetid | ms.date | ms.localizationpriority |
---|---|---|---|---|---|---|
Expected Sub, Function, or Property |
vblr6.chm1011162 |
vblr6.chm1011162 |
office |
cb6d9b37-d190-dd46-cba4-ea6f9c6b7f3d |
06/08/2017 |
medium |
The syntax of your statement indicates a Sub, Function, or Property procedure invocation. This error has the following cause and solution:
-
The specified name isn’t that of a Sub, Function, or Property procedure in scope in this part of your program.
Check the spelling of the name. Note that if the procedure is defined as Private, it can only be called from within its module.
For additional information, select the item in question and press F1 (in Windows) or HELP (on the Macintosh).
[!includeSupport and feedback]
Function GetPingResult(Host)
Dim objPing As Object
Dim objStatus As Object
Dim strResult As String
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
ExecQuery("Select * from Win32_PingStatus Where Address = '" & Host & "'")
For Each objStatus In objPing
Select Case objStatus.StatusCode
Case 0: strResult = "Connected"
Case 11001: strResult = "Buffer too small"
Case 11002: strResult = "Destination net unreachable"
Case 11003: strResult = "Destination host unreachable"
Case 11004: strResult = "Destination protocol unreachable"
Case 11005: strResult = "Destination port unreachable"
Case 11006: strResult = "No resources"
Case 11007: strResult = "Bad option"
Case 11008: strResult = "Hardware error"
Case 11009: strResult = "Packet too big"
Case 11010: strResult = "Request timed out"
Case 11011: strResult = "Bad request"
Case 11012: strResult = "Bad route"
Case 11013: strResult = "Time-To-Live (TTL) expired transit"
Case 11014: strResult = "Time-To-Live (TTL) expired reassembly"
Case 11015: strResult = "Parameter problem"
Case 11016: strResult = "Source quench"
Case 11017: strResult = "Option too big"
Case 11018: strResult = "Bad destination"
Case 11032: strResult = "Negotiating IPSEC"
Case 11050: strResult = "General failure"
Case Else: strResult = "Unknown host"
End Select
GetPingResult = strResult
Next
Set objPing = Nothing
End Function
Sub GetIPStatus()
Dim Cell As Range
Dim ipRng As Range
Dim Result As String
Dim Wks As Worksheet
Set Wks = Worksheets("Sheet1")
Set ipRng = Wks.Range("A2")
Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp)
Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd))
For Each Cell In ipRng
If Cell.Value <> "" Then
Result = GetPingResult(Cell)
Cell.Offset(0, 1) = Result
Else
Cell.Offset(0, 1) = "No IP specified!"
End If
Next Cell
End Sub
Private Sub Clear_Contents_Click()
Range("A2:B10000").Select
Selection.ClearContents
Range("A2").Select
End Sub
Private Sub DNSLookup_Click()
Range("C2:C10000").Select
Selection.ClearContents
Range("A2").Select
For x = 2 To Sheets("Sheet1").Range("A10000").End(xlUp).Row
Dim IPAddy As String
Dim LookupResult As String
IPAddy = Sheets("Sheet1").Cells(x, 1).Value
LookupResult = NSLookup(IPAddy, 0)
Sheets("Sheet1").Cells(x, 3) = LookupResult
Next x
End Sub
Private Sub Ping_Click()
Range("B2:C10000").Select
Selection.ClearContents
Range("A2").Select
GetIPStatus
End Sub
Public Function NSLookup(lookupVal As String, Optional addressOpt As Integer) As String
Const ADDRESS_LOOKUP = 1
Const NAME_LOOKUP = 2
Const AUTO_DETECT = 0
'Skip everything if the field is blank
If lookupVal <> "" Then
Dim oFSO As Object, oShell As Object, oTempFile As Object
Dim sLine As String, sFilename As String
Dim intFound As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Wscript.Shell")
'Handle the addresOpt operand
'Regular Expressions are used to complete a substring match for an IP Address
'If an IP Address is found, a DNS Name Lookup will be forced
If addressOpt = AUTO_DETECT Then
ipLookup = FindIP(lookupVal)
If ipLookup = "" Then
addressOpt = ADDRESS_LOOKUP
Else
addressOpt = NAME_LOOKUP
lookupVal = ipLookup
End If
'Do a regular expression substring match for an IP Address
ElseIf addressOpt = NAME_LOOKUP Then
lookupVal = FindIP(lookupVal)
End If
'Run the nslookup command
sFilename = oFSO.GetTempName
oShell.Run "cmd /c nslookup " & lookupVal & " > " & sFilename, 0, True
Set oTempFile = oFSO.OpenTextFile(sFilename, 1)
Do While oTempFile.AtEndOfStream <> True
sLine = oTempFile.Readline
cmdStr = cmdStr & Trim(sLine) & vbCrLf
Loop
oTempFile.Close
oFSO.DeleteFile (sFilename)
'Process the result
intFound = InStr(1, cmdStr, "Name:", vbTextCompare)
If intFound = 0 Then
NSLookup = ""
Exit Function
ElseIf intFound > 0 Then
'TODO: Cleanup with RegEx
If addressOpt = ADDRESS_LOOKUP Then
loc1 = InStr(intFound, cmdStr, "Address:", vbTextCompare) + InStr(intFound, cmdStr, "Addresses:", vbTextCompare)
loc2 = InStr(loc1, cmdStr, vbCrLf, vbTextCompare)
nameStr = Trim(Mid(cmdStr, loc1 + 8, loc2 - loc1 - 8))
ElseIf addressOpt = NAME_LOOKUP Then
loc1 = InStr(intFound, cmdStr, "Name:", vbTextCompare)
loc2 = InStr(loc1, cmdStr, vbCrLf, vbTextCompare)
nameStr = Trim(Mid(cmdStr, loc1 + 5, loc2 - loc1 - 5))
End If
End If
NSLookup = nameStr
Else
NSLookup = "N/A"
End If
End Function
Public Function FindIP(strTest As String) As String
Dim RegEx As Object
Dim valid As Boolean
Dim Matches As Object
Dim i As Integer
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Pattern = "b(?:d{1,3}.){3}d{1,3}b"
valid = RegEx.test(strTest)
If valid Then
Set Matches = RegEx.Execute(strTest)
FindIP = Matches(0)
Else
FindIP = ""
End If
End Function
-
08-29-2005, 09:05 PM
#1
Compile error: Expected Sub, Function, or Property
I don’t program very much so I am prone to silly errors. I just can’t
get the following subprocedure to call my funtion. I keep getting the
«Compile error: Expected Sub, Function, or Property» error message when
the program tries to execute the line:
CheckNumber = CorrectABNDigits(CellContents).
When stepping through the code, the function is highlighted after the
call, so it seems to recognise it, but then it won’t step into it,
giving me the same error message over and over. What am I doing wrong?
Why isn’t my function a function even if the debugger jumps to it?I am trying to get the program to read the contents of a cell into
«CellContents», pass this string to the function «Function
CorrectABNDigits(CellContents As String) As Boolean», and then do some
checks on the string. But my sub won’t call my function.Any further comments / criticisms regarding the way I have programmed
this are welcome!Sub ABNtidy()
Dim CellContents As String
Dim CheckNumber As BooleanRange(«E2»).Select
CellContents = Selection.Value
CheckNumber = CorrectABNDigits(CellContents)
MsgBox (CheckNumber)
End SubFunction CorrectABNDigits(CellContents As String) As Boolean
Dim MyCheck As BooleanIf Len(CellContents) = 11 Then MyCheck ’11 characters in cell
CorrectABNDigits = MyCheck
End Function
-
08-29-2005, 10:05 PM
#2
Re: Compile error: Expected Sub, Function, or Property
This line looks like it’s missing something:
If Len(CellContents) = 11 Then MyCheck ’11 characters in cell
maybe:
If Len(CellContents) = 11 Then MyCheck = True ’11 characters in cell
?????
Cloudfall wrote:
>
> I don’t program very much so I am prone to silly errors. I just can’t
> get the following subprocedure to call my funtion. I keep getting the
> «Compile error: Expected Sub, Function, or Property» error message when
> the program tries to execute the line:
> CheckNumber = CorrectABNDigits(CellContents).
> When stepping through the code, the function is highlighted after the
> call, so it seems to recognise it, but then it won’t step into it,
> giving me the same error message over and over. What am I doing wrong?
> Why isn’t my function a function even if the debugger jumps to it?
>
> I am trying to get the program to read the contents of a cell into
> «CellContents», pass this string to the function «Function
> CorrectABNDigits(CellContents As String) As Boolean», and then do some
> checks on the string. But my sub won’t call my function.
>
> Any further comments / criticisms regarding the way I have programmed
> this are welcome!
>
> Sub ABNtidy()
> Dim CellContents As String
> Dim CheckNumber As Boolean
>
> Range(«E2»).Select
> CellContents = Selection.Value
> CheckNumber = CorrectABNDigits(CellContents)
> MsgBox (CheckNumber)
> End Sub
>
> Function CorrectABNDigits(CellContents As String) As Boolean
> Dim MyCheck As Boolean
>
> If Len(CellContents) = 11 Then MyCheck ’11 characters in cell
> CorrectABNDigits = MyCheck
> End Function—
Dave Peterson
-
08-29-2005, 11:11 PM
#3
Cloudfall
in this line of code
If Len(CellContents) = 11 Then MyCheckExcel appears to be treating MyCheck as sub routine or a function.
Try
If Len(CellContents) = 11 Then MyCheck = True
Another way to write your code is
Sub ABNtidy()
Dim CheckNumber As BooleanCheckNumber = CorrectABNDigits(Range(«a2»).Value)
MsgBox (CheckNumber)
End SubFunction CorrectABNDigits(CellContents As String) As Boolean
Dim MyCheck As BooleanIf Len(CellContents) = 11 Then MyCheck = True ’11 characters in cell
CorrectABNDigits = MyCheck
End Function
-
08-30-2005, 01:05 AM
#4
Re: Compile error: Expected Sub, Function, or Property
To Dave Peterson and mudraker:
You were both spot on. For some reason I had thought that a declared
boolean variable would simply default to true in an «if…then»
statement if the «if» part was correct (I thought I remembered learning
this somewhere). I won’t make this mistake again. I never expected an
error of this kind to generate the «Compile error: Expected Sub,
Function, or Property» error message. I thought it was talking about
«Function CorrectABNDigits(CellContents As String) As Boolean» when it
was talking about MyCheck (as mudraker helpfully pointed out above).
That’s why the debugger did indeed jump to «Function
CorrectABNDigits(CellContents As String) As Boolean» but refused to
execute any of its code.And mudraker’s suggestion regarding «CheckNumber =3D
CorrectABNDigits(Range(«a2″).V=ADalue) » is far more elegant. I wasn’t
aware you could do this. I don’t know Excel VBA very well so I am
finding this group phenomenally helpful (including past answers to
other peoples’ questions). I am now faced with a major programming
chore and I am trying to use good habits from the very beginning.Thank you for your fast responses and I wish you both all the very
best.