2015-01-01 65 views
1

我正在创建一个不同的人将添加到的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 
+0

那么我不知道是否有其他替代方案,因为我想阻止用户在填满他们的行之前保存文件 –

+1

好的,谢谢你的建议。 –

+1

检查** UsedRange **属性;) –

回答

1

要扩展建议的解决方案,您可以执行以下操作。

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

这将选择which've尚未填写范围A1的所有单元格:纸张的I1,而不是通过每个单元循环,你的问题可以有效地与两行代码解决。或者,你可以使用一些颜色来使其更加明确。如果有效,不要忘记接受答案。

+0

谢谢,它的工作原理是当它设置为'rsave.SpecialCells(xlCellTypeBlanks).Select'而不是'cell.Select'。 2行代码是不够的,或者我做错了什么。 –

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 

祝你好运!