VBA/Excel/Access/Word/Language Basics/Function — различия между версиями
Admin (обсуждение | вклад) м (1 версия) |
|
(нет различий)
|
Версия 16:33, 26 мая 2010
Содержание
- 1 A function returns a value to whomever called it.
- 2 A function returns a value to whomever called it. We can recast the previous sub into a function as follows:
- 3 A function with one argument
- 4 Call user-defined function in MsgBox
- 5 Convert Fahrenheit To Celsius
- 6 Executing a Function Procedure from a Subroutine
- 7 function takes two arguments"s length and width"s and calculates the total area by multiplying them together
- 8 One of simplest possible custom functions
- 9 Select Case in a function
- 10 Use ElseIf in a function
- 11 Writing VBA Function Procedures
A function returns a value to whomever called it.
Sub useaFunction()
MsgBox concatF()
End Sub
Function concatF() As String
Dim strFirstname As String
Dim strLastName As String
Dim strFullName As String
strFirstname = "John"
strLastName = "Smith"
strFullName = strFirstname & " " & strLastName
concatF = strFullName
End Function
A function returns a value to whomever called it. We can recast the previous sub into a function as follows:
Function concat() As String
Dim strFirstname As String
Dim strLastName As String
Dim strFullName As String
strFirstname = "John"
strLastName = "Smith"
strFullName = strFirstname & " " & strLastName
concat = strFullName
End Function
A function with one argument
Function Commission(Sales)
" Calculates sales commissions
Dim Tier1 As Double, Tier2 As Double
Dim Tier3 As Double, Tier4 As Double
Tier1 = 0.08
Tier2 = 0.105
Tier3 = 0.12
Tier4 = 0.14
Select Case Sales
Case 0 To 9999.99: Commission = Sales * Tier1
Case 10000 To 19999.99: Commission = Sales * Tier2
Case 20000 To 39999.99: Commission = Sales * Tier3
Case Is >= 40000: Commission = Sales * Tier4
End Select
Commission = Round(Commission, 2)
End Function
=Commission(25000)
Call user-defined function in MsgBox
Function CtoF(Centigrade)
CtoF = Centigrade * 9 / 5 + 32
End Function
Sub Main()
MsgBox CtoF(100)
End Sub
Convert Fahrenheit To Celsius
Private Sub TestFahrenheitToCelsius()
Debug.Print FahrenheitToCelsius(32)
If (FahrenheitToCelsius(32) <> 0) Then
Debug.Print "TestFahrenheitToCelsius: Failed"
Debug.Assert False
Else
Debug.Print "TestFahrenheitToCelsius: Passed"
End If
End Sub
Public Function FahrenheitToCelsius(ByVal TemperatureFahrenheit As Double) As Double
FahrenheitToCelsius = (5 / 9 * (TemperatureFahrenheit - 32))
End Function
Executing a Function Procedure from a Subroutine
Sub EnterText()
Dim strFirst As String, strLast As String, strFull As String
strFirst = InputBox("Enter your first name:")
strLast = InputBox("Enter your last name:")
strFull = JoinText(strFirst, strLast)
MsgBox strFull
End Sub
Function JoinText(k, o)
JoinText = k + " " + o
End Function
function takes two arguments"s length and width"s and calculates the total area by multiplying them together
Function Area(Length, Width)
Area = Length * Width
End Function
Sub aSub()
MsgBox Area(100, 50)
End Sub
One of simplest possible custom functions
Function GetMyFavoriteColor()
GetMyFavoriteColor = "Magenta"
End Function
Sub mSub()
MsgBox GetMyFavoriteColor()
End Sub
Select Case in a function
Public Function AssignGrade(studScore As Single) As String
Select Case studScore
Case 90 To 100
AssignGrade = "A"
Case 80 To 89
AssignGrade = "B"
Case 70 To 79
AssignGrade = "C"
Case Else
AssignGrade = "F"
End Select
End Function
Use ElseIf in a function
Public Function LoanCriteria(loanAmt As Single, numPayments As Integer, _
moPayment As Integer, totInterest As Single) As Boolean
If Abs(moPayment) > 400 Then
LoanCriteria = False
ElseIf Abs(totInterest) > (0.1 * loanAmt) Then
LoanCriteria = False
ElseIf numPayments > 48 Then
LoanCriteria = False
Else
LoanCriteria = True
End If
End Function
Writing VBA Function Procedures
Private Sub Main2()
Dim num1 As Double
Dim myRoot As Double
num1 = 10
myRoot = SqRoot(num1)
myRoot = Format(myRoot, "#0.00")
MsgBox "The square root of " & num1 & "is " & myRoot
End Sub
Public Function SqRoot(ByVal num1 As Double) As Double
num1 = Sqr(num1)
SqRoot = num1
End Function