Question

我试图限制excel工作表中某些单元格的输入，如下所示： 1-7,10,12，这意味着只有0到9和符号-和,的数字才会出现在单元格中。我想以非基于非vba的数据验证方式理想地处理它，但即使是基于vba的解决方案也可以。

编辑 - 有一个关键字是一个例外，'固定'，如果我看到这个词是允许的。

Answer 1

使用Regex对象的VBA版本：我刚写了这个函数。您只需在Sheet change事件中调用此函数即可。（就像Siddharth一样）。另外一件事，每次用户输入错误的字符时，该功能都会将它们全部删除：D ......然后，您需要注意确保此操作在您选择的特定范围内发生..否则它可以擦除任何正在更改的单元！鉴于Siddtharth的帖子infinite loops within this `worksheet change event，我已编辑代码以包含该位。

    Option Explicit

    '-- within sheet change event
    Private Sub Worksheet_Change(ByVal Target As Range)
       On Error GoTo Zoo
       Application.EnableEvents = False
       Call NumbersAndCommaDashOnly(Target)

       GetBack:
       Application.EnableEvents = True
       Exit Sub
   Zoo:
       MsgBox Err.Description
       Resume GetBack
    End Sub

Function NumbersAndCommaDashOnly(ByRef rngInput As Range) As String    
Dim objRegex As Object
Dim strInput As String

Set objRegex = CreateObject("VBScript.RegExp")
objRegex.IgnoreCase = True
objRegex.Global = True
objRegex.Pattern = "^[-,0-9]+$|^[Fixed]$"

If Not IsNull(rngInput.Value) Then
    strInput = rngInput.Value
Else
    NumbersAndCommaDash = "Empty Range"
    rngInput.Value = ""
    Exit Function
End If

If objRegex.Test(rngInput.Value) Then
    NumbersAndCommaDash = objRegex.Replace(rngInput, "")
Else
    NumbersAndCommaDash = "No numbers found"
    rngInput.Value = ""
End If

End Function

对于基于Excel公式的解决方案，您可以查看此MSDN article。

Answer 2

这是一个仅适用于单元格A1的VBA方法。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long

    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Range("A1")) Is Nothing Then
        If Len(Range("A1").Value) <> 0 Then
            For i = 1 To Len(Range("A1").Value)
                Select Case Asc(Mid(Range("A1").Value, i, 1))
                '~~> Check for 0-9, "," and "-"
                Case vbKey0 To vbKey9, 44, 45
                Case Else
                    Range("A1").ClearContents
                    MsgBox "Invalid Value"
                    Exit For
                End Select
            Next
        End If
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

代码进入Sheet1代码区。

enter image description here

屏幕截图（代码在行动中）

enter image description here

关注到问题中的最近编辑

更改行

If Len(Range("A1").Value) <> 0 Then

到

If Len(Range("A1").Value) <> 0 And _
UCase(Range("A1").Value) <> "FIXED" Then

excel 2007中的数据验证

2 个答案: