数据验证宏

时间:2015-01-01 19:44:58

标签: excel vba

我正在创建一个不同人要添加的Excel工作表,所以我想知道是否有任何简单的方法可以检查用户开始写入的行?

例如,如果用户开始在单元格A1中键入,则宏检查单元格是否填充在同一行上。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim rsave As Range
Dim cell As Range
Set rsave = Sheet1.Range("a1:i1")
For Each cell In rsave
If cell = "" Then
    Dim missdata
    missdata = MsgBox("missing data", vbOKOnly, "Missing Data")
    Cancel = True
    cell.Select  
    Exit For
   End If
  Next cell
End Sub

2 个答案:

答案 0 :(得分:1)

要扩展建议的解决方案,您可以执行以下操作。您可以使用两行代码有效地解决问题,而不是遍历每个单元格:

  'get the used range
  Set rsave = Sheet1.Range("a1:i1")
  'Select all blank(not yet filled) cells
  rsave.SpecialCells(xlCellTypeBlanks).Select

这将选择未在纸张范围a1:i1中填充的所有单元格。或者,您可以使用某种颜色使其更明确。如果有效,请不要忘记接受答案。

答案 1 :(得分:0)

如果说“数据验证”,你的意思是检查空白,你可以使用:

Sub Test()

Dim wrng As Range

Set wrng = ActiveSheet.UsedRange
MsgBox "The data in a range: '" & wrng.Address & "' are" & IIf(IsValidData(wrng), "", "n't") & " valid"
Set wrng = Nothing

End Sub

Function IsValidData(rng As Range) As Boolean

IsValidData = rng.SpecialCells(xlCellTypeBlanks).Count = 0

End Function

请注意, UsedRange 方法会返回从 A1 单元格开始的范围。因此,您需要添加额外的代码来选择数据占用的范围(跳过空白行和列)。

Sub Test()

Dim wrng As Range
Set wrng = GetDataRange()

MsgBox "The data in a range: '" & wrng.Address & "' are" & IIf(IsValidData(wrng), "", "n't") & " valid"

End Sub

Function GetDataRange() As Range

Dim wrng As Range, c As Range, saddr As String
Dim pos As Integer

'get used range
Set wrng = ActiveSheet.UsedRange
'find first non-empty cell in a used range
saddr = ActiveSheet.Range(wrng.End(xlToLeft).Address, wrng.End(xlUp).Address).Address
pos = InStr(1, saddr, ":")
'skip blanks rows and set new range
Set GetDataRange = ActiveSheet.Range(Mid(saddr, pos + 1, Len(saddr) - pos) & ":" & wrng.SpecialCells(xlCellTypeLastCell).Address)

Set wrng = Nothing

End Function
祝你好运!