[已解决]根据某个单元格有无数据来判断某几列单元格有且只能填一列数据

pandengyisun

根据某个单元格有无数据来判断某几列单元格有且只能填一列数据，具体要求如附件。
分级唯一.xls.zip (16.61 KB, 下载次数: 7)

2015-11-26 10:14 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

yorkchenshunan

2015-11-26 11:01

你给的附件我无法在I列下面填写数据（一填写EXCEL就出错并强制退出）进行程序检测，但应该问题不大，

1. Sub check()
   
2. Dim rg As Range, r%, c%, xh%, str$
   
3. Set rg = Sheets(1).UsedRange.Find("件号/规格型号")
   
4. r = rg.Row
   
5. c = rg.Column
   
6. For xh = r + 1 To 300
   
7. If IsEmpty(Cells(xh, c)) Then
   
8.     If Application.WorksheetFunction.CountA(Range(Cells(xh, 1), Cells(xh, c - 1))) > 0 Then
   
9.         str = str & "," & xh
   
10.     End If
    
11. Else
    
12.     If Application.WorksheetFunction.CountA(Range(Cells(xh, 1), Cells(xh, c - 1))) <> 1 Then
    
13.         str = str & "," & xh
    
14.     End If
    
15. End If
    
16. Next xh
    
17. MsgBox "第" & Right(str, Len(str) - 1) & "行存在错误"
    
18. End Sub

复制代码

跳转到最佳答案楼层

yorkchenshunan

你给的附件我无法在I列下面填写数据（一填写EXCEL就出错并强制退出）进行程序检测，但应该问题不大，

1. Sub check()
   
2. Dim rg As Range, r%, c%, xh%, str$
   
3. Set rg = Sheets(1).UsedRange.Find("件号/规格型号")
   
4. r = rg.Row
   
5. c = rg.Column
   
6. For xh = r + 1 To 300
   
7. If IsEmpty(Cells(xh, c)) Then
   
8.     If Application.WorksheetFunction.CountA(Range(Cells(xh, 1), Cells(xh, c - 1))) > 0 Then
   
9.         str = str & "," & xh
   
10.     End If
    
11. Else
    
12.     If Application.WorksheetFunction.CountA(Range(Cells(xh, 1), Cells(xh, c - 1))) <> 1 Then
    
13.         str = str & "," & xh
    
14.     End If
    
15. End If
    
16. Next xh
    
17. MsgBox "第" & Right(str, Len(str) - 1) & "行存在错误"
    
18. End Sub

复制代码

pandengyisun

yorkchenshunan 发表于 2015-11-26 11:01
你给的附件我无法在I列下面填写数据（一填写EXCEL就出错并强制退出）进行程序检测，但应该问题不大，

很感谢你。但如果不加On Error Resume Next这个语句，如果Excel里面什么都不填，会出错。如下图：

yorkchenshunan

pandengyisun 发表于 2015-11-26 11:47
很感谢你。但如果不加On Error Resume Next这个语句，如果Excel里面什么都不填，会出错。如下图：

嗯，见下

1. Sub check()
   
2. Dim rg As Range, r%, c%, xh%, str$
   
3. Set rg = Sheets(1).UsedRange.Find("件号/规格型号")
   
4. r = rg.Row
   
5. c = rg.Column
   
6. For xh = r + 1 To 300
   
7. If IsEmpty(Cells(xh, c)) Then
   
8.     If Application.WorksheetFunction.CountA(Range(Cells(xh, 1), Cells(xh, c - 1))) > 0 Then
   
9.         str = str & "," & xh
   
10.     End If
    
11. Else
    
12.     If Application.WorksheetFunction.CountA(Range(Cells(xh, 1), Cells(xh, c - 1))) <> 1 Then
    
13.         str = str & "," & xh
    
14.     End If
    
15. End If
    
16. Next xh
    
17. If Len(str) = 0 Then
    
18. MsgBox "检查完毕，无错误"
    
19. Else
    
20. MsgBox "第" & Right(str, Len(str) - 1) & "行存在错误"
    
21. End If
    
22. End Sub
    

复制代码