创建数组公式
Public Function testrange(rng As Range) As Variant Dim r() As Variant
Dim i As Long, j As Long
ReDim r(1 To rng.Rows.Count, 1 To rng.Columns.Count) For i = 1 To rng.Rows.Count
For j = 1 To rng.Columns.Count r(i, j) = rng.Cells(i, j).Value + 1 Next j Next i
testrange = r
End Function
应用实例
成绩统计辅助函数 加分功能
Function scoreadd(score As Double, add As Double) As Double score = score + add If score > 100 Then score = 100 End If
scoradd = score
End Function
分数到等级
Public Function scoretoclass(score As Double) As String If score < 60 Then
scoretoclass = \不及格\
ElseIf score >= 60 And score < 70 Then scoretoclass = \及格\
ElseIf score >= 70 And score < 80 Then scoretoclass = \一般\
ElseIf score >= 80 And score < 90 Then scoretoclass = \良好\Else
scoretoclass = \优秀\
End If
End Function 统计成绩段
Function scorecount(rng As Range, min As Double, max As Double) As Long Dim r As Range Dim c As Long
c = 0
For Each r In rng
If r >= min And r < max Then c = c + 1 End If Next
scorecount = c End Function
从身份证提取性别
Function getsex(strnum As String) As String Dim i As Long
If Len(strnum) = 18 Then i = Mid(strnum, 17, 1) ElseIf Len(strnum) = 15 Then i = Mid(strnum, 15, 1) Else
getsex = \错误\ Exit Function End If
If i Mod 2 = 0 Then getsex = \女\ Else getsex = \男\ End If End Function
从身份证提取生日
Function getbrithday(strum As String) As Date Dim y As String Dim m As String Dim d As String
Dim birthday As String If Len(strnum) = 18 Then y = Mid(strnum, 7, 4) m = Mid(strnum, 11, 2) d = Mid(strnum, 13, 2)
ElseIf Len(strnum) = 15 Then y = Mid(strnum, 7, 2) m = Mid(strnum, 9, 2) d = Mid(strnum, 11, 2) Else
getbirthday = \Exit Function End If
birthday = y & \
getbirthday = CDdate(brithday)
End Function VBA语言
VBA程序的组成 模块
Dim I as long
Dim strname as string Private I as long
Public strname as string
过程
{private|public|}{static} sub name [(arglist)] {statements} {exit sub} {statements} End sub
函数
{private|public|}{static} function name [(arglist)] {as type} {statements}
{name=expressiuon} {statements}
{name=expressiuon} End function
过程和函数的调用 过程单个参数的调用 Sub main（） Multibeep 56 Message End sub
Sub multibeep(numbeeps) For counter=1 to numbeeps Beep
Next counter End sub
Sub message()
Msgbox “time to take a break” End sub
过程多个参数的调用 Sub main()
housecalc 99800, 43100
Call housecall(380950, 49500) End Sub
Sub housecalc(price As Single, wage As Single)
If 2.5 * wage <= 0.8 * price Then
MsgBox \Else
MsgBox \End If End Sub 函数的调用 分数到等级
Public Function scoretoclass(score As Double) As String If score < 60 Then
scoretoclass = \不及格\
ElseIf score >= 60 And score < 70 Then scoretoclass = \及格\
ElseIf score >= 70 And score < 80 Then scoretoclass = \一般\
ElseIf score >= 80 And score < 90 Then scoretoclass = \良好\Else
scoretoclass = \优秀\End If
控制程序流程 条件语句
If condition then {statements}
{elseif condition-n then { elseif statements}} {else
{ else statements}} End if Eg.
Dim number, digits, mystring number = 53
If number < 10 Then digits = 1
ElseIf number < 100 Then digits = 2 Else difits = 2 Else
digits = 3 End If
SELECT CASE语句
Select case textexpression {Case expressionlist-n {statements-n}} {Case else
{elsestatements}} End selct
Eg.case 1 to 4, 7 to 9,11,13,is>maxnumber Eg.
Function bonus(performance, salary) Select Case performance Case 1
bonus = salary * 0.1 Case 2, 3
bonus = salary * 0.09 Case 4 To 6
bonus = salary * 0.07 Case Is > 8 bonus = 100 Case Else bonus = 0 End Select End Function 循环语句 Do…loop
Do [{while|until} condition] [statements] [exit do] [statements] Loop
或者 Do
[statements] [exit sub] [statements]
Loop [{while|until} condition] For …next
For counter=start to end [step step] [statements] [exit for] [statements] Next [counter] For each..next
For each element in group