Option Explicit
Function Lbanji(mynum As Integer)
Dim mysh As Worksheet
Dim addR As Integer, r1 As Integer, r As Integer, c As Integer
addR = 1
r = ActiveCell.Row
c = ActiveCell.Column
For Each mysh In ThisWorkbook.Worksheets
If mysh.Name = "一班" Then
For r1 = 7 To 57
If mysh.Cells(r1, 3) = Sheet1.[d10] Then
If mynum = addR Then Lbanji = mysh.Name
addR = addR + 1
End If
Next
End If
Next
For Each mysh In ThisWorkbook.Sheets
If mysh.Name = "二班" Then
For r1 = 7 To 57
If mysh.Cells(r1, 3) = Sheet1.[d10] Then
If mynum = addR Then Lbanji = mysh.Name
addR = addR + 1
End If
Next
End If
Next
For Each mysh In ThisWorkbook.Sheets
If mysh.Name = "三班" Then
For r1 = 7 To 57
If mysh.Cells(r1, 3) = Sheet1.[d10] Then
If mynum = addR Then Lbanji = mysh.Name
addR = addR + 1
End If
Next
End If
Next
If mynum >= addR Then Lbanji = "已全部列出"
End Function
Function Lxinming(mynum As Integer)
Dim mysh As Worksheet
Dim addR As Integer, r1 As Integer, r As Integer, c As Integer
addR = 1
r = ActiveCell.Row
c = ActiveCell.Column
For Each mysh In ThisWorkbook.Worksheets
If mysh.Name = "一班" Then
For r1 = 7 To 57
If mysh.Cells(r1, 3) = Sheet1.[d10] Then
If mynum = addR Then Lxinming = mysh.Cells(r1, 2)
addR = addR + 1
End If
Next
End If
Next
For Each mysh In ThisWorkbook.Sheets
If mysh.Name = "二班" Then
For r1 = 7 To 57
If mysh.Cells(r1, 3) = Sheet1.[d10] Then
If mynum = addR Then Lxinming = mysh.Cells(r1, 2)
addR = addR + 1
End If
Next
End If
Next
For Each mysh In ThisWorkbook.Sheets
If mysh.Name = "三班" Then
For r1 = 7 To 57
If mysh.Cells(r1, 3) = Sheet1.[d10] Then
If mynum = addR Then Lxinming = mysh.Cells(r1, 2)
addR = addR + 1
End If
Next
End If
Next
If mynum >= addR Then Lxinming = "已全部列出"
End Function
附件:
辛苦了,应该鼓励一下:)
[此贴子已经被apolloh于2005-11-21 9:35:17编辑过] |