vb中如何显示平均排名（如何用vb统计成绩）

本文于2023年9月10日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！

内容提要

工作表权限控制代码解析

VBA代码

1、在用户窗体Usf_Login里：

Dim arrUser() Private Sub UserForm_Initialize() Dim ws As Worksheet Dim lastRow As Integer Set ws = ThisWorkbook.Sheets("用户权限表") With ws lastRow = .UsedRange.Rows.Count arrUser = .Range("A2:D" & lastRow).Value End With End Sub Private Sub CmdLogin_Click() Dim ws As Worksheet Dim x As Integer Application.ScreenUpdating = False If Me.TxbUserID = "" Then MsgBox "请输入用户ID！" Exit Sub End If If Me.TxbPassWord = "" Then MsgBox "请输入密码！" Exit Sub End If For i = 1 To UBound(arrUser) If arrUser(i, 1) = Me.TxbUserID Then x = 1 If CStr(arrUser(i, 3)) = CStr(Me.TxbPassWord) Then currUser = arrUser(i, 1) currPermission = arrUser(i, 4) Call BackTo For Each ws In ThisWorkbook.Sheets If currPermission = "All" Then ws.Visible = xlSheetVisible Else If InStr(currPermission, "/" & ws.Name & "/") Then ws.Visible = xlSheetVisible End If End If Next Set ws = Sheets("Main") ws.Range("A1").Value = "当前用户：" & currUser & "(" & arrUser(i, 2) & ") " & Chr(10) & "用户权限：" & currPermission If currPermission = "All" Or InStr(currPermission, "/用户权限表/") Then ws.OLEObjects("CmdUserManage").Visible=True ws.OLEObjects("CmdUserSheet").Visible = True End If Unload Me Exit For Else MsgBox "密码不正确，请重新输入！" With Me.TxbPassWord .SetFocus .SelStart = 0 ' 将光标位置设置为文本框的开头 .SelLength = Len(.Text) ' 选择整个文本框的文本 End With Exit For End If End If Next If x = 0 Then MsgBox "无此用户ID，请重新输入!" Exit Sub End If Application.ScreenUpdating = True End Sub Private Sub CmdExit_Click() Call BackTo Unload Me EndSub

代码解析：

（1）Line1，定义模块级数组arrUser，用来存放用户权限表信息。

（2）line2~10，用户窗体初始化过程，把“用户权限表”存入数组arrUser。

（3）line12~64，登录按钮点击事件。

（A）line16~23，检查用户ID与密码是否输入，不能为空。

（B）line24~41，把用户输入的信息与数组中的信息进行比对，如果相符，则显示“权限”中的工作表。把当前登录用户的权限信息写入工作表“Main”的A1单元格。

（C）line42~45，如果如果权限为“All”或者有“用户权限表”的，工作表“Main”中的两个关于“用户权限”的按钮可见。

（D）line49~55，如果密码不符，则给出提示信息，退出过程，把控件焦点设为TxbPassWord，并选中内容，便于重新输入。

（E）line59~62，如果用户ID未正确输入，则给出提示信息，退出过程。

（4）line66~69，退出按钮点击事件。用户不输入用户名密码，点退出隐藏窗体进入工作表，为防止显示权限以外的表，这里干脆把除了“Main“以外的表全部隐藏。

2、在用户窗体Usf_Permission里：

Dim arrUser() PrivateSubUserForm_Initialize() Dim arrSheets() Dim topPos As Integer Dim ws As Worksheet Dim iWidth As Integer Dim lastRow As Integer Set ws = ThisWorkbook.Sheets("用户权限表") With ws lastRow = .UsedRange.Rows.Count arrUser = .Range("A2:D" & lastRow).Value End With For i = 1 To UBound(arrUser) If arrUser(i, 1) <> "" And arrUser(i, 1) <> "admin" Then Me.Cmbuser.AddItem arrUser(i, 1) End If Next For Each ws In ThisWorkbook.Sheets If ws.Name <> "Main" Then ReDim Preserve arrSheets(k) arrSheets(k) = ws.Name k = k 1 End If Next leftPos = Me.Lbpermission.Left 10 ' 复选框的左侧位置 topPos = Me.Lbpermission.Top Me.Lbpermission.Height 10 ' 复选框的顶部位置 iWidth = 60 For i = LBound(arrSheets) To UBound(arrSheets) '在指定位置插入复选框 Me.Controls.Add "Forms.CheckBox.1", "CheckBox" & i '设置复选框的位置和属性 With Me.Controls("CheckBox" & i) .Left = leftPos .Top = topPos .Width = iWidth .Height = 20 .Caption = arrSheets(i) .Value = False End With '更新位置 If (i 1) Mod 6 = 0 Then '换行 leftPos = Me.Lbpermission.Left 10 topPos = topPos 20 Else '同行下一个位置 leftPos = leftPos iWidth End If Next End Sub Private Sub Cmbuser_Change() Dim ctrl As Control For i = 1 To UBound(arrUser) If arrUser(i, 1) = Me.Cmbuser Then Me.LbUser = arrUser(i, 2) For Each ctrl In Controls If ctrl.Name Like "CheckBox*" Then ctrl.Value = False ctrl.ForeColor = vbBlack If InStr(arrUser(i, 4), "/" & ctrl.Caption & "/") Then ctrl.Value = True ctrl.ForeColor = vbRed End If End If Next EndIf Next End Sub Private Sub CmdSave_Click() Dim ws As Worksheet Dim newPermission As String Dim ctrl As Control Dim userCell As Range Set ws = ThisWorkbook.Sheets("用户权限表") ForEachctrlInControls If ctrl.Name Like "CheckBox*" Then If ctrl.Value = True Then newPermission = newPermission & "/" & ctrl.Caption End If End If Next newPermission = newPermission & "/" Set userCell = ws.Range("A:A").Find(Me.Cmbuser, LookIn:=xlValues) If Not userCell Is Nothing Then userCell.Offset(0, 3) = newPermission Else MsgBox "无此用户！" End If Unload Me Usf_Permission.Show End Sub Private Sub CmdCheck_Click() If Not wContinue("即将清除无效的工作表权限！") Then Exit Sub Dim oldPermission As String Dim newPermission As String Dim ws As Worksheet Dim wb As Workbook Set wb = ThisWorkbook For i = 1 To UBound(arrUser) oldPermission = arrUser(i, 4) If oldPermission <> "All" Then For Each ws In wb.Sheets If InStr(oldPermission, "/" & ws.Name & "/") Then newPermission = newPermission & "/" & ws.Name End If Next If newPermission <> "" Then newPermission = newPermission & "/" End If arrUser(i, 4) = newPermission newPermission = "" End If Next Set ws = wb.Sheets("用户权限表") ws.Range("A2").Resize(UBound(arrUser), 4) = arrUser MsgBox "权限整理完毕！" Unload Me Usf_Permission.Show End Sub Private Sub CmeExit_Click() Unload Me EndSub

代码解析：

（1）Line1，定义模块级数组arrUser，用来存放用户权限表信息。

（2）line2~50，用户窗体初始化过程，把“用户权限表”存入数组arrUser，把工作表名称作为CheckBox控件的Caption列出来。

（A）line13~17，把用户ID添加到组合框的list。

（B）line18~24，把除“Main”以外的工作表名装入数组。

（C）line25~49，把工作表名作为CheckBox的Caption，添加到用户窗体，供勾选，动态添加控件的代码直接复制【Excel VBA 学生成绩排名（更新）/SQL循环查询/嵌套查询】，稍作修改。

（3）line52~69，Cmbuser_Change事件，根据当前用户的权限信息，把对应CheckBox勾选并改为红色。

（4）line71~93，保存按钮点击事件。把勾选的工作表名写入用户权限表。

（5）line95~122，整理按钮点击事件。如果在设置好用户权限后，工作表有改名或删除的，那么用户权限就可能有不存在的表。把这些不存在的工作表权限删除。

（6）line124~126，退出按钮点击事件，退出过程。

3、在myModule里，两个自定义函数：

Public currUser As String Public currPermission As String Sub BackTo() Dim ws As Worksheet Dim curSht As String On Error Resume Next Sheets("Main").Activate ActiveSheet.Visible = xlSheetVisible '显示工作表 curSht = ActiveSheet.Name '遍历所有工作表，隐藏不需要显示的工作表 For Each ws In Excel.ThisWorkbook.Worksheets If ws.Name <> curSht Then '设置工作表对象的Visible属性 'ws.Visible = xlSheetHidden ws.Visible = xlSheetVeryHidden End If Next End Sub Function wContinue(Msg) As Boolean '确认继续函数 Dim Config As Long Config = vbYesNo vbDefaultButton2 vbQuestion Ans = MsgBox(Msg & Chr(10) & "是(Y)继续?" & Chr(10) _ & "否(N)返回！", Config, "请确认操作！") wContinue = Ans = vbYes EndFunction

代码解析：

（1）Line1~2，定义两个公共变量。

（2）line4~19，回到主页，返回到工作表“Main”，隐藏其他工作表。

（3）line21~28，确认继续执行函数。

4、在工作表“Main”里：

Private Sub CmdLogin_Click() Me.CmdUserManage.Visible = False Me.CmdUserSheet.Visible = False Me.Range("A1") = "" Usf_Login.Show End Sub Private Sub CmdUserManage_Click() Usf_Permission.Show End Sub Private Sub CmdUserSheet_Click() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("用户权限表") With ws .Visible = xlSheetVisible .Activate End With End Sub Private Sub Worksheet_Deactivate() If currUser = "" Then Me.CmdUserManage.Visible = False Me.CmdUserSheet.Visible = False Me.Range("A1") = "" Call BackTo Usf_Login.Show End If End Sub

代码解析：

（1）Line1~6，用户登录按钮点击事件，把其他两个命令按钮隐藏，A1单元格清空，然后再显示用户登录窗体Usf_Login。

（2）line8~10，用户权限管理按钮点击事件，显示用户权限管理窗体Usf_Permission。

（3）line12~19，用户权限表按钮点击事件，显示“用户权限表”。

（4）line21~29，工作表Deactivate事件，工作表转为非激活，等同于点击其他工作表。这里如果系发生统异常，用户权限信息被清空，则返回到工作表“Main”，隐藏其他工作表，显示用户登录窗体，必须重新登录后才能使用，以防止进入权限以外的工作表。

5、在ThisWorkBook里：

Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim ws As Worksheet Dim sp As Shape Call BackTo Set ws = Sheets("Main") ws.OLEObjects("CmdUserManage").Visible = False ws.OLEObjects("CmdUserSheet").Visible = False ws.Range("A1") = "" ThisWorkbook.Save End Sub Private Sub Workbook_Open() Usf_Login.Show EndSub

代码解析：

（1）Line1~10，工作簿BeforeClose关闭前事件，调用BackTo过程，把工作表“Main”上的其他两个按钮隐藏，A1单元格清空。

（2）line12~14，工作簿Open打开事件，显示用户登录窗体Usf_Login。。

~~~~~~End~~~~~~

喜欢就点个赞、点在看、留个言、分享一下呗！感谢！