Question

我的Excel工作表中有5个不同的列，每个列都有不同的数据验证规则。当用户通过键盘手动输入时，我的规则正在运行但是，虽然复制粘贴来自不同来源的数据，例如notepad，one note等，但我的验证并不起作用。只有当您单独点击cell时才有效示例：我的列就像， Name, Employee ID, Plan ID, Client Name, Email ID等

我需要某种VBA或公式，当用户从不同来源复制/粘贴数据时，我的数据验证会自动生效。

Answer 1

是的，我遇到了同样的问题。我通过阻止粘贴来解决它。在模块中，我有一个代码：

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

然后，在我输入的工作表代码中：

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

正如您所看到的，我已禁用公式栏以防止用户直接复制到其中。这个对我有用。

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

和另一个用于检查，如果在两个长点之间插入值：

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

然后，应该使用验证时表格中的一个小宏：

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

我假设第一列要对某些列表进行检查，第二列应该在1000000到9999999之间。但是你可以相应地修改它。如您所见，我不使用excel验证 - 粘贴时，用户可能会无意中覆盖此问题。我已经制作了用黄色填充非有效单元格的宏，但你可以命令它做其他事情。如果您认为有人可能会尝试粘贴1 000或更多值，我不推荐使用msgbox。

从不同来源

2 个答案: