碰到两次要给用户加权限(用户数较多的情况),有的是数据库在存在的用户,有的是数据库没有的,需要新建用户,所以写了个Excel的宏!
先把数据库在存在的用户找出来,导出为EXCEL,再把需要添加权限的用户加到EXCEL的另一列中,再运行宏进行对比!
可以在EXCEL中添加个按钮,指定宏,也可以按 Alt+F8 运行宏!
宏代码如下(添加为模块代码,且宏安全需设置为低):
Sub CheckUsers()
Dim MyColCompare
InPutCel:
MyColCompare = Application.InputBox(Prompt:="请输入需要对比的两列,用英文逗号隔开(,)!" & vbCrLf & vbCrLf & "例如:A,C", Default:="A,B", Title:="请输入需要对比的列", Type:=2 + 4)
If MyColCompare = False Then Exit Sub Else MyColCompare = Replace(MyColCompare, " ", "")
Dim SubCel() As String
SubCel() = Split(MyColCompare, ",")
If UBound(SubCel()) <> 1 Or Replace(MyColCompare, ",", "") = "" Then MsgBox "请输入两个列号,用英文逗号隔开,如:A,C", vbOKOnly + vbExclamation, "提示!": GoTo InPutCel
If Len(SubCel(0)) <> 1 Or Len(SubCel(1)) <> 1 Then MsgBox "本程序只能对比 A-Z 之间的列,请重新输入,如:A,C", vbOKOnly + vbExclamation, "提示!": GoTo InPutCel
If Not ((Asc(SubCel(0)) >= 65 And Asc(SubCel(0)) <= 90) Or (Asc(SubCel(0)) >= 97 And Asc(SubCel(0)) <= 122)) Or Not ((Asc(SubCel(1)) >= 65 And Asc(SubCel(1)) <= 90) Or (Asc(SubCel(1)) >= 97 And Asc(SubCel(1)) <= 122)) Then
MsgBox "本程序只能处理A-Z之间的列,请重新输入,如:A,C", vbOKOnly + vbExclamation, "提示!"
GoTo InPutCel
End If
Dim i As Long, j As Long
i = 1
Range(SubCel(0) & i).Select
Do Until Range(SubCel(0) & i).Value = ""
Range(SubCel(0) & i).Select
j = 1
Do Until Range(SubCel(1) & j).Value = ""
If Range(SubCel(0) & i).Value = Range(SubCel(1) & j).Value Then
Range(SubCel(0) & i).Interior.Color = RGB(200, 160, 35)
Range(SubCel(1) & j).Interior.Color = vbRed
End If
j = j + 1
Loop
i = i + 1
Loop
End Sub