在Excel中快速根据学号输入成绩的VBA应用
时间:2011-05-03
来源:互联网
请将以下程序放到工作表的代码部分(确保已经启用宏)
Dim tRange As String '保存上一次所访问的范围
PRivate Sub Worksheet_Activate() '当从别的工作表切换到本工作表时出现提示
MsgBox ("在R3中输入学号并按回车键后会自动定位到所找学生行,输完内容后按右箭头回到R3!!")
MsgBox "已经使用:(" & Sheet1.UsedRange.Rows.Count & "行," & Sheet1.UsedRange.Columns.Count & "列)"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lie '定义你要输入分数的列,A:1,B:2,C:3,D:4,E:5……
Lie = 8 '假定默认为在第8列即H列中输入分数
'以下判断是否在R3中输入待查找学号
If (Target.Row = 3) And (Target.Column = 18) And (ActiveCell.Value <> "") Then
For Each c In [A4:A120]
If Trim(c.Value) Like ("*" & Trim(ActiveCell.Value)) Then
Range(c.Address & ":" & Chr(Asc("A") - 1 + Lie) & c.Row).Select
tRange = Selection.Address '将选定的范围保存到临时变量中
Selection.Interior.ColorIndex = 33 '选中后背景颜色的变化
Selection.Interior.Pattern = xlSolid
c.Offset(0, Lie - 1).Select '选定区域中最后一单元格
Exit For '已经找到目标学号退出继续查找程序
End If
Next
ElseIf (Target.Column = Lie) And (ActiveCell.Value <> "") Then
If tRange <> "" Then
Range(tRange).Select
Selection.Interior.ColorIndex = xlNone
End If
Range("R3").Select
End If
End Sub
Dim tRange As String '保存上一次所访问的范围
PRivate Sub Worksheet_Activate() '当从别的工作表切换到本工作表时出现提示
MsgBox ("在R3中输入学号并按回车键后会自动定位到所找学生行,输完内容后按右箭头回到R3!!")
MsgBox "已经使用:(" & Sheet1.UsedRange.Rows.Count & "行," & Sheet1.UsedRange.Columns.Count & "列)"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lie '定义你要输入分数的列,A:1,B:2,C:3,D:4,E:5……
Lie = 8 '假定默认为在第8列即H列中输入分数
'以下判断是否在R3中输入待查找学号
If (Target.Row = 3) And (Target.Column = 18) And (ActiveCell.Value <> "") Then
For Each c In [A4:A120]
If Trim(c.Value) Like ("*" & Trim(ActiveCell.Value)) Then
Range(c.Address & ":" & Chr(Asc("A") - 1 + Lie) & c.Row).Select
tRange = Selection.Address '将选定的范围保存到临时变量中
Selection.Interior.ColorIndex = 33 '选中后背景颜色的变化
Selection.Interior.Pattern = xlSolid
c.Offset(0, Lie - 1).Select '选定区域中最后一单元格
Exit For '已经找到目标学号退出继续查找程序
End If
Next
ElseIf (Target.Column = Lie) And (ActiveCell.Value <> "") Then
If tRange <> "" Then
Range(tRange).Select
Selection.Interior.ColorIndex = xlNone
End If
Range("R3").Select
End If
End Sub
作者: 猥琐的舌头 发布时间: 2011-05-03
帮顶一下!
作者: EMA6178 发布时间: 2011-05-03
相关阅读 更多
热门阅读
-
office 2019专业增强版最新2021版激活秘钥/序列号/激活码推荐 附激活工具
阅读:74
-
如何安装mysql8.0
阅读:31
-
Word快速设置标题样式步骤详解
阅读:28
-
20+道必知必会的Vue面试题(附答案解析)
阅读:37
-
HTML如何制作表单
阅读:22
-
百词斩可以改天数吗?当然可以,4个步骤轻松修改天数!
阅读:31
-
ET文件格式和XLS格式文件之间如何转化?
阅读:24
-
react和vue的区别及优缺点是什么
阅读:121
-
支付宝人脸识别如何关闭?
阅读:21
-
腾讯微云怎么修改照片或视频备份路径?
阅读:28