Excel VBA高效办公应用-第十一章-教师员工数据管理-Part2 （课表助手小程序）

这个例子也不错，挺有启发性。

界面：

代码：

Option ExplicitDim Iweek As Integer '定义Iweek获得当前的星期数Sub Myfind()'定义Sstring获取单元格的内容,Lstr获取单元格内容的长度'定义Inum获取一天总共有多少节课,Sjie(4)获取第几节课Dim Sstring As String, Lstr As Integer, Inum As Integer, Sjie(4) As String'定义Sclass获取班级的内容，Ssubject获取课程的内容，Sroom获取教室的内容'Sweek获取星期的内容Dim Sclass(4) As String, Ssubject(4) As String, Sroom(4) As String, Sweek As StringDim i As Integer, j As Integer    Inum = 0 '初始化num为0    Iweek = Weekday(Now) '利用时间函数获取星期数的数字    '如果是星期天，则退出程序。因为一般学校星期天是没课的    If Iweek = 1 Then    MsgBox "哈哈，今天没有课，可以休息啦"    End    End If    Sheets("课表").Activate '激活课表工作表    Sweek = Cells(1, Iweek).Value    For i = 2 To 5        Sheets("课表").Activate '激活课表工作表        '获取当天各课程单元格的内容        Sstring = Cells(i, Iweek).Value        '获取课程单元格内有关课程的字串长度        Lstr = Len(Sstring) - 5        '如果为空则表示这节课没课,非空表示有课        If (Sstring <> "") Then        Inum = Inum + 1 '总课数加1        Sjie(Inum) = Cells(i, 1).Value '取得节数        Ssubject(Inum) = Left(Sstring, Lstr)  '取得课程名        Sclass(Inum) = Right(Sstring, 4) '取得班级名        '调用函数Room获取教室名        Sroom(Inum) = Room(Ssubject(Inum))        End If    Next i        '传递现在得到的星期，节，课程，班级，教室和总节数给函数tishi    Tishi Sweek, Sjie(), Ssubject(), Sclass(), Sroom(), InumEnd SubFunction Room(Ske As String) As String'激活授课地点表，以便对其进行操作Sheets("授课地点").ActivateSelect Case Trim(Ske)    Case "高等数学"        '如果课程是高等数学就取第二行的相关数据        Room = Cells(2, Iweek).Value    Case "线性代数"        '如果课程是线性代数就取第三行的相关数据         Room = Cells(3, Iweek).Value    Case "概率"         '如果课程是概率就取第四行的相关数据        Room = Cells(4, Iweek).Value    Case "离散数学"        '如果课程是离散数学就取第五行的相关数据        Room = Cells(5, Iweek).ValueEnd SelectEnd Function    '函数Tishi是用来提醒用户Sub Tishi(Sweek As String, Sjie() As String, Ssubject() As String, Sclass() As String, Sroom() As String, Inum As Integer)    Dim Sstr As String, i As Integer '定义Sstr为表示提示信息    Sstr = ""    For i = 1 To Inum        Sstr = Sstr + "第" + Sjie(i) + "是" + Ssubject(i) + ",在" + Sroom(i) + "给" + Sclass(i) + "上课" + vbCrLf    Next i        '提示用户    MsgBox "今天是" + Sweek + ",今天您有" + str(Inum) + "节课" + vbCrLf + SstrEnd Sub