|
Sub 查询() '通过姓名查询记录
xm = Worksheets("信息录入表").[d5]
With Worksheets("学生基本情况")
r_end = .Range("A65536").End(xlUp).Row
For r = 2 To r_end
If .Cells(r, "B") = xm Then Call 显示(r): Exit For
Next
If r = r_end + 1 Then MsgBox "没有人员信息!"
End With
End Sub
Sub 录入() '把当前录入表信息更新到数据表的第大行+1
With Sheets("学生基本情况")
r = .[b65536].End(3).Row + 1
Call 记录(r)
End With
End Sub
Sub 修改() '通过姓名查询记录后更新记录
xm = Worksheets("信息录入表").[d5]
With Worksheets("学生基本情况")
r_end = .Range("A65536").End(xlUp).Row
For r = 2 To r_end
If .Cells(r, "B") = xm Then Call 录入(r): Exit For
Next
If r = r_end + 1 Then MsgBox "没有人员信息!"
End With
End Sub
Sub 显示(r) '把数据表的第r行记录显示在当前录入表中
Set d = CreateObject("scripting.dictionary")
With Sheets("学生基本情况")
For i = 1 To 72
d(.Cells(1, i).Value) = .Cells(r, i).Value
Next
End With
With Sheets("信息录入表")
For i = 5 To 49
a = .Cells(i, "B").Value: b = .Cells(i, "F").Value
a = Replace(a, "★", ""): b = Replace(b, "★", "")
.Cells(i, "D") = d(a): .Cells(i, "H") = d(b)
Next
End With
End Sub
Sub 记录(r) '把当前录入表信息更新到数据表的第r行
Set d = CreateObject("scripting.dictionary")
With Sheets("信息录入表")
For i = 5 To 49
a = .Cells(i, "B").Value: b = .Cells(i, "F").Value
a = Replace(a, "★", ""): b = Replace(b, "★", "")
d(a) = .Cells(i, "D").Value: d(b) = .Cells(i, "H").Value
Next
End With
With Sheets("学生基本情况")
For i = 1 To 72
.Cells(r, i).Value = d(.Cells(1, i).Value)
Next
End With
MsgBox "更新完毕"
End Sub |
|