[已解决]求一段检查错误的代码

eking_tang

求一段检查错误的代码
劳烦各位出手相助
不胜感激

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-5-14 13:56

1. Sub demo1()
   
2.     Dim rg As Range
   
3.     On Error Resume Next
   
4.     Set rg = Range("b30:O200").CurrentRegion.SpecialCells(xlCellTypeConstants, 22)
   
5.     If Not rg Is Nothing Then
   
6.         MsgBox "有不符数据" & vbCr & rg.Address(False, False)
   
7.         rg.Select
   
8.     End If
   
9. End Sub
   

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Sub demo1()
   
2.     Dim rg As Range
   
3.     On Error Resume Next
   
4.     Set rg = Range("b30:O200").CurrentRegion.SpecialCells(xlCellTypeConstants, 22)
   
5.     If Not rg Is Nothing Then
   
6.         MsgBox "有不符数据"
   
7.     End If
   
8. End Sub
   

复制代码

取巧做的。

hwc2ycy

1. Sub demo1()
   
2.     Dim rg As Range
   
3.     On Error Resume Next
   
4.     Set rg = Range("b30:O200").CurrentRegion.SpecialCells(xlCellTypeConstants, 22)
   
5.     If Not rg Is Nothing Then
   
6.         MsgBox "有不符数据" & vbCr & rg.Address(False, False)
   
7.         rg.Select
   
8.     End If
   
9. End Sub
   

复制代码

xdragon

1. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   
2.   Dim arr, i&, j%, rng As Range
   
3.   arr = Range("B30:O200")
   
4.   For i = 1 To UBound(arr)
   
5.     For j = 1 To UBound(arr, 2)
   
6.       If IsNumeric(arr(i, j)) = False And IsDate(arr(i, j)) = False Then
   
7.         If rng Is Nothing Then Set rng = Cells(i + 29, j + 1) Else Set rng = Union(rng, Cells(i + 29, j + 1))
   
8.       End If
   
9.     Next
   
10.   Next
    
11.   If Not rng Is Nothing Then MsgBox rng.Address
    
12. End Sub

复制代码

windimi007

Test!

1. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   
2.     Dim ar
   
3.     ar = Range("B30:O200")
   
4.     For j = 1 To UBound(ar, 2)
   
5.         For i = 1 To UBound(ar)
   
6.             If Not (IsNumeric(ar(i, j)) Or IsDate(ar(i, j))) Then
   
7.                 MsgBox "有其他字符！", vbOKOnly, "提示"
   
8.                 Cancel = True
   
9.                 Exit Sub
   
10.             End If
    
11.         Next i
    
12.     Next j
    
13. End Sub

复制代码

eking_tang

hwc2ycy 发表于 2014-5-14 13:56

有劳版主大人了
,也衷心感谢XDRAGON和WINDIMI007两位大侠.

eking_tang

版主大人回复最快~~所以就选他了