Excel 使用VBA检查用户名是否在范围内

我有以下Excel电子表格：

     A         B        C         D       E
1            Username1
2            Username2
3            Username3
4            Username4
5            
6

在

范围B1:B4

中，我列出了应允许运行以下VBA的所有用户：

Sub Button_Value()
If Environ("Username") = Sheet1.Range("B1") _
Or Environ("Username") = Sheet1.Range("B2") _
Or Environ("Username") = Sheet1.Range("B3") _
Or Environ("Username") = Sheet1.Range("B4") Then
Sheet1.Range("A1").Value = 3
Else
Answer = MsgBox("Function not available")
End If
End Sub

所有这些都非常有效

---

---

但是，不，我想知道是否有办法检查

用户名
是否存在于
范围B1:B4
中，这样我就不必为我要添加的每个新用户使用
或
功能了？
您可以使用
范围。查找
如下：

Sub Button_Value()

    If userExists Then
       Sheet1.Range("A1").Value = 3
    Else
       Msgbox "Function Not Available"
    End If

End Sub

Function userExists() as Boolean

    Dim user as String
    user = Environ("username")

    userExists = IsNumeric(Application.match(user,Sheet1.Range("B1:B4"),0))

End Function

Dim rng As Range

With Sheet1
    Set rng = .Range(.Cells(1, 2), .Cells(Rows.Count, 2).End(xlUp))
    If Not rng.Find(Environ("Username")) Is Nothing Then
        .Cells(1, 1).Value = 3
    Else
        Answer = MsgBox("Function not available")
    End If
End With

这还将根据
B
列中的用户名数量进行调整。根据评论和答案，有以下两个选项可解决此问题：

选项A（Application.Match）

选项B（范围.查找）

我知道你有两个答案，但第三个答案是使用字典检查用户名是否存在：

            Sub test()
            Dim username As String 'declare the username
            Dim r As Range: Set r = Sheet1.Range("B1:B4") 'dim and set your range
            Dim UserNames As Scripting.Dictionary 'dim dictionary
                Set UserNameDic = New Scripting.Dictionary 'set your dictionary to a new one
            Dim x As Integer 'counter just for the dictionary value
                x = 1

            'loops through each cell in your range
            For Each u In r
                UserNameDic.Add u.Value, x 'adds your username to the dictionary
                x = x + 1
            Next

            If Not UserNameDic.Exists(Environ("username")) Then: MsgBox "Access      Denied" 'checks to see if the username exisits in the dictionary
            End Sub

使用
范围。查找
或
应用程序。匹配
。
Sub Button_Value()
With Sheet1
    Set Rng = Sheet.Range("B1:B4")
    If Not Rng.Find(Environ("Username")) Is Nothing Then
    Sheet1.Range("A1").Value = 3
    Else
     Answer = MsgBox("Function not available")
    End If
End With
End Sub

            Sub test()
            Dim username As String 'declare the username
            Dim r As Range: Set r = Sheet1.Range("B1:B4") 'dim and set your range
            Dim UserNames As Scripting.Dictionary 'dim dictionary
                Set UserNameDic = New Scripting.Dictionary 'set your dictionary to a new one
            Dim x As Integer 'counter just for the dictionary value
                x = 1

            'loops through each cell in your range
            For Each u In r
                UserNameDic.Add u.Value, x 'adds your username to the dictionary
                x = x + 1
            Next

            If Not UserNameDic.Exists(Environ("username")) Then: MsgBox "Access      Denied" 'checks to see if the username exisits in the dictionary
            End Sub