《第8章--函数的使用代码【超实用VBA】》由会员分享，可在线阅读，更多相关《第8章--函数的使用代码【超实用VBA】（10页珍藏版）》请在金锄头文库上搜索。
1、第8章 函数的使用范例119 使用时间和日期函数119-1 计算程序运行时间Sub MyTime() Dim i As Integer Dim StartTime As Single Dim EndTime As Single StartTime = Timer For i = 1 To 10000 Cells(1, 1) = i Next EndTime = Timer - StartTime MsgBox 程序运行时间： & Format(EndTime, 0.00) & 秒End Sub119-2 获得当月的最后一天Sub Endday() Dim Endday As Byte Endd
2、ay = Day(DateSerial(Year(Date), Month(Date) + 1, 0) MsgBox 当月最后一天是 & Month(Date) & 月 & Endday & 号End Sub119-3 计算某个日期为星期几Sub Myweekday() Dim StrDate As String Dim Myweekday As String StrDate = InputBox(请输入日期：) If Len(StrDate) = 0 Then Exit Sub If IsDate(StrDate) Then Select Case Weekday(StrDate, vbSu
3、nday) Case vbSunday Myweekday = 星期日 Case vbMonday Myweekday = 星期一 Case vbTuesday Myweekday = 星期二 Case vbWednesday Myweekday = 星期三 Case vbThursday Myweekday = 星期四 Case vbFriday Myweekday = 星期五 Case vbSaturday Myweekday = 星期六 End Select MsgBox DateValue(StrDate) & & Myweekday Else MsgBox 请输入正确格式的日期! E
4、nd IfEnd Sub119-4 计算两个日期的时间间隔Sub DateInterval() Dim StrDate As String StrDate = InputBox(请输入日期：) If Len(StrDate) = 0 Then Exit Sub If IsDate(StrDate) Then MsgBox DateValue(StrDate) & Chr(13) & 距离今天有 _ & Abs(DateDiff(d, Date, StrDate) & 天 Else MsgBox 请输入正确格式的日期! End IfEnd Sub119-5 获得指定时间间隔的日期Sub MyDa
5、teAdd() Dim StrDate As String StrDate = Application.InputBox(Prompt:=请输入间隔的天数：, Type:=1) If StrDate = False Then Exit Sub MsgBox StrDate & 天后的日期是 & DateAdd(d, StrDate, Date)End Sub119-6 格式化时间和日期Sub TimeDateFormat() Dim Str As String Str = Format(Now, Medium Time) & Chr(13) _ & Format(Now, Long Time)
6、 & Chr(13) _ & Format(Now, Short Time) & Chr(13) _ & Format(Now, General Date) & Chr(13) _ & Format(Now, Long Date) & Chr(13) _ & Format(Now, Medium Date) & Chr(13) _ & Format(Now, Short Date) MsgBox StrEnd Sub范例120 使用字符串处理函数Sub StrFunctions() Dim Str As String Str = Use String Functions MsgBox 原始字符
7、串： & Str & Chr(13) _ & 字符串长度： & Len(Str) & Chr(13) _ & 左边8个字符： & Left(Str, 8) & Chr(13) _ & 右边6个字符： & Right(Str, 6) & Chr(13) _ & Str出现在字符串的第 & InStr(Str, Str) & 位 & Chr(13) _ & 从左边第5个开始取6个字符： & Mid(Str, 5, 6) & Chr(13) _ & 转换为大写： & UCase(Str) & Chr(13) _ & 转换为小写： & LCase(Str) & Chr(13)End Sub范例121
8、判断表达式是否为数值Sub MyNumeric() Dim r As Integer Dim rng As Range Dim Ynumber As String Dim Nnumber As String r = Cells(Rows.Count, 1).End(xlUp).Row For Each rng In Range(A1:A & r) If IsNumeric(rng) Then Ynumber = Ynumber & rng.Address(0, 0) & vbTab & rng & vbCrLf Else Nnumber = Nnumber & rng.Address(0, 0
9、) & vbTab & rng & vbCrLf End If Next MsgBox 数值单元格： & vbCrLf & Ynumber & vbCrLf _ & 非数值单元格： & vbCrLf & NnumberEnd Sub范例122 自定义数值格式Sub CustomDigitalFormat() Dim MyNumeric As Double Dim Str As String MyNumeric = 123456789 Str = Format(MyNumeric, 0.00) & vbCrLf _ & Format(MyNumeric, 0%) & vbCrLf _ & For
10、mat(MyNumeric, #,#0.00) & vbCrLf _ & Format(MyNumeric, $#,#0.00) & vbCrLf _ & Format(-(MyNumeric), ￥#,#0.00;(￥#,#0.00) MsgBox StrEnd Sub范例123 四舍五入运算Sub Rounding() MsgBox Round(4.56789, 2)End SubSub AmendmentsRound() MsgBox Round(2.5 + 0.0000001)End SubSub SheetsRound() MsgBox Application.Round(2.5,
11、0)End Sub范例124 使用Array函数创建数组Option Base 1Sub Myarr() Dim arr As Variant Dim i As Integer arr = Array(王晓明, 吴胜玉, 周志国, 曹武伟, 张新发, 卓雪梅, 沈煜婷, 丁林平) For i = LBound(arr) To UBound(arr) Cells(i, 1) = arr(i) NextEnd Sub范例125 将字符串按指定的分隔符分开Sub Splitarr() Dim Arr As Variant Arr = Split(Cells(1, 2), ,) Cells(1, 1)
12、.Resize(UBound(Arr) + 1, 1) = Application.Transpose(Arr)End Sub范例126 使用动态数组去除重复值Sub Splitarr() Dim Splarr() As String Dim Arr() As String Dim Temp() As String Dim r As Integer Dim i As Integer On Error Resume Next Splarr = Split(Range(B1), ,) For i = 0 To UBound(Splarr) Temp = Filter(Arr, Splarr(i) If UBound(Temp) 0 Then r = r + 1 ReDim Preserve Arr(1 To r) Arr(r) = Splarr(i) End If Next Range(A1).Resize(r, 1) = Application.Transpose(Arr)End Sub范例127 调用工作表函数127-1 使用Sum函数求和Sub SumCell() Dim r As Integer Dim rn
