excel - Excel 2007 でのデータ検証

Question

Excelワークシートの特定のセルの入力を次のように制限しようとしています: 、これは、セルに1-7,10,12数字と記号のみが表示されることを意味0し9ます。理想的には、vba ベース以外のデータ検証方法で処理したいのですが、vba ベースのソリューションでも問題ありません。-,

編集 - 「固定」という例外となるキーワードが 1 つあります。この単語が表示された場合は許可されます。

Answer 1

Regexオブジェクトを使用した VBA バージョン: 関数を記述したところです。この関数は、シート変更イベント内で簡単に呼び出すことができます。（シッダールスが使用した方法のように）。もう1つ、ユーザーが間違った文字を入力するたびに、関数はそれらをすべて削除します:D ...もう一度、この操作が選択した特定の範囲内で確実に行われるようにする必要があります。変更中のセルを消去!!! infinite loopsこの `worksheet change event 内での Siddtharth の投稿を考慮して、コードを編集してそのビットも含めました。

    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 の記事を参照してください。

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コード領域に入ります。

スクリーンショット (コードの動作)

質問の最近の編集へのフォローアップ

行を変更する

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

に

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