異なるソースからのデータのコピー/ペースト時にデータ検証がExcelで動作する方法

Question

私のExcelシートに5つの異なる列があり、それぞれに別々のデータ検証規則があります。私のルールは、ユーザーが手動でキーボードから入力するときに機能しています。
しかし、notepad,one noteなどの異なるソースからコピーデータをコピーしている間、私の検証は機能しません。個別にcellをクリックすると動作します。
例：私の列は、私は私のデータの検証が自動的に別のソースからのユーザー・コピー/貼り付けデータを働くいくつかのVBAの種類や式を必要 Name, Employee ID, Plan ID, Client Name, Email IDなど

、のようなものです。

Answer 1

はい、私は同じ問題を抱えています。私は貼り付けを全くブロックすることでそれを解決しました。あなたが見ることができるように、私もそれに直接ユーザーのコピーを防止するために無効な数式バーを持っている

Private Sub Worksheet_Activate() 
    Application.DisplayFormulaBar = False 
End Sub 

Private Sub Worksheet_Change(ByVal Target As Range) 
    NotAllowPaste 
End Sub 

Private Sub Worksheet_Deactivate() 
    Application.DisplayFormulaBar = True 
End Sub 

：

Sub NotAllowPaste() 
Dim UndoList As String 
If ThisWorkbook.Name <> ActiveWorkbook.Name Then Exit Sub 
With Application 
    .EnableEvents = False 
    UndoList = .CommandBars("Standard").Controls("&Undo").List(1) 
    If InStr(UndoList, "Paste") > 0 Or _ 
    UndoList = "Keep Source Formatting" Or _ 
    UndoList = "Drag and Drop" Then 
     .Undo 
     MsgBox "Pasting and ""drag and drop"" is forbidden in this workbook.", vbCritical 
    End If 
    .EnableEvents = True 
End With 
End Sub 

次に、ワークシートのコードでは、私が入れている：モジュールで、私は、コードを持っています。わたしにはできる。

Answer 2

通常モジュールでは、リストに対してチェックサブルーチン：

Sub ListToCheck(rng As Range) 
Dim cl As Range 
Dim i As Integer 
Dim bMatch As Boolean 
Dim sListName As String 

sListName = "sheet2!MyList" 'change this accrording to your needs 
bMatch = False 

For Each cl In rng.Cells 
    With WorksheetFunction 
    For i = 1 To .CountA(Range("MyList")) 
     If cl.Value = .Index(Range(sListName), i) Then bMatch = True 
    Next i 
    End With 

    With cl.Interior 
    If bMatch Then 
     .ColorIndex = 0 
    Else 
     .Color = vbYellow 
    End If 
    End With 
    bMatch = False 
Next cl 

End Sub 

及び値は、2つのlong値の間に挿入された場合、確認のためにもう一つ：そして

Sub ValueToCheck(rng As Range, minV As Long, maxV As Long) 
Dim cl As Range 
Dim bOk As Boolean 

For Each cl In rng.Cells 
    With cl 
    If IsNumeric(.Value) Then 

     If .Value < minV Or .Value > maxV Then 
      .Interior.Color = vbYellow 
     Else 
      .Interior.ColorIndex = 0 
     End If 
    Else 
     .Interior.Color = vbYellow 
    End If 
    End With 
Next cl 
End Sub 

、内の1つの小さなマクロシートを使用する場合：

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim col As Range 
Dim colAdr As String 

For Each col In Target.Columns 
    colAdr = col.Address(ReferenceStyle:=xlR1C1) 
    Select Case Right(colAdr, Len(colAdr) - InStrRev(colAdr, "C")) 
     Case Is = 1 
      ListToCheck col 
     Case Is = 2 
      ValueToCheck col, 1000000, 9999999 
     End Select 
Next col 
End Sub 

私は最初の列がいくつかのリストに対してチェックされ、2番目のリストは1000000〜9999999になります。しかしそれに応じてそれを変更することができます。ご覧のように、私はExcelのバリデーションを使用していません。貼り付ける際に誤って上書きされる可能性があります。私は、有効でない細胞を黄色で塗りつぶすようにマクロを作ったが、何か他のことをするように命令することができる。誰かが1 000個以上の値を貼り付けようとしていると思われる場合は、msgboxをおすすめしません。