[已解决]提示代码，谢谢

fangniuji

帮忙写个提示代码，AE列，后面如果没有数据的，就提示。如AE到Ai数据就提示：第3行0.4，后面无数据，第13行1.1后面无数据。20行0.6后面没有数据，谢谢

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-12-18 23:31

1. Sub 提示2()
   
2.     Dim arr, i&, j As Byte, str$
   
3.     i = Cells(Rows.Count, "ae").End(xlUp).Row   '判断数据行号
   
4.     If i = 1 Then Exit Sub
   
5.     arr = Range("ae1:ai" & i).Value          '取数据
   
6.     For i = LBound(arr) To UBound(arr)
   
7.         If Len(arr(i, 1)) > 0 Then              '判断第一列是否为空
   
8.             For j = 2 To UBound(arr, 2)         '判断第二列开始后是否有空数据
   
9.                 If Len(arr(i, j)) = 0 Then
   
10.                     '生成提示信息
    
11.                     str = str & "第 " & i & "行 " & Format(arr(i, 1), "0.0") & "，后面无数据" & vbCr
    
12.                     Exit For
    
13.                 End If
    
14.             Next
    
15.         End If
    
16.     Next
    
17.     If Len(str) > 0 Then MsgBox str '检测信息长度，判断是否该显示提示信息
    
18. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

这个你应该能写出来了啊。

hoogle

怎么提示，是一起提示，还是一行一行提示？

hwc2ycy

1. Sub 提示()
   
2.     Dim arr, i&, j As Byte, str$
   
3.     'i = Cells(Rows.Count, "ae").End(xlUp).Row
   
4.     arr = Range("ae1").CurrentRegion
   
5.     For i = LBound(arr) To UBound(arr)
   
6.     If Len(arr(i, 1)) > 0 Then
   
7.         For j = 2 To UBound(arr, 2)
   
8.             If Len(arr(i, j)) = 0 Then
   
9.                 str = str & "第 " & i & "行 " & arr(i, 1) & "，后面无数据" & vbCr
   
10.                 Exit For
    
11.             End If
    
12.         Next
    
13.     End If
    
14.     Next
    
15.     MsgBox str
    
16. End Sub
    

复制代码

hwc2ycy

1. Sub 提示()
   
2.     Dim arr, i&, j As Byte, str$
   
3.     'i = Cells(Rows.Count, "ae").End(xlUp).Row
   
4.     arr = Range("ae1").CurrentRegion
   
5.     For i = LBound(arr) To UBound(arr)
   
6.         If Len(arr(i, 1)) > 0 Then
   
7.             For j = 2 To UBound(arr, 2)
   
8.                 If Len(arr(i, j)) = 0 Then
   
9.                     str = str & "第 " & i & "行 " & Format(arr(i, 1), "0.0") & "，后面无数据" & vbCr
   
10.                     Exit For
    
11.                 End If
    
12.             Next
    
13.         End If
    
14.     Next
    
15.     If Len(str) > 0 Then MsgBox str
    
16. End Sub

复制代码

hwc2ycy

1. Sub 提示2()
   
2.     Dim arr, i&, j As Byte, str$
   
3.     i = Cells(Rows.Count, "ae").End(xlUp).Row   '判断数据行号
   
4.     If i = 1 Then Exit Sub
   
5.     arr = Range("ae1").CurrentRegion            '取数据
   
6.     For i = LBound(arr) To UBound(arr)
   
7.         If Len(arr(i, 1)) > 0 Then              '判断第一列是否为空
   
8.             For j = 2 To UBound(arr, 2)         '判断第二列开始后是否有空数据
   
9.                 If Len(arr(i, j)) = 0 Then
   
10.                     '生成提示信息
    
11.                     str = str & "第 " & i & "行 " & Format(arr(i, 1), "0.0") & "，后面无数据" & vbCr
    
12.                     Exit For
    
13.                 End If
    
14.             Next
    
15.         End If
    
16.     Next
    
17.     If Len(str) > 0 Then MsgBox str '检测信息长度，判断是否该显示提示信息
    
18. End Sub

复制代码

fangniuji

hoogle 发表于 2012-12-18 17:44
怎么提示，是一起提示，还是一行一行提示？

一行一行提示，谢谢。

hoogle

1. Sub hoogle()
   
2. Dim i, arr
   
3. arr = Range("ai1", [ae1].End(xlDown))
   
4. For i = 1 To UBound(arr)
   
5.     If Len(arr(i, 1)) = 0 Then Exit For
   
6.     If Len(arr(i, 2) & arr(i, 3) & arr(i, 4) & arr(i, 5)) = 0 Then
   
7.         MsgBox "第" & i & "行" & arr(i, 1)
   
8.     End If
   
9. Next
   
10. End Sub
    

复制代码

hoogle

提示.zip (321.28 KB, 下载次数: 2)

2012-12-18 19:01 上传

点击文件名下载附件

fangniuji

hwc2ycy 发表于 2012-12-18 17:56

为什么报错，帮我改改，谢谢！！！