ahyyf关于填写重复的题目

zhaogang1960

刚刚写完代码，发现原帖不见了：

1. Sub Macro1()
   
2.     Dim arr, brr$(), i&
   
3.     arr = Range("A1").CurrentRegion
   
4.     ReDim brr(2 To UBound(arr), 1 To 1)
   
5.     For i = 2 To UBound(arr)
   
6.         If arr(i, 4) = arr(i, 6) Then brr(i, 1) = "填重复了，请核实。"
   
7.     Next
   
8.     [h2].Resize(i - 2) = brr
   
9. End Sub
   

复制代码

人员信息表（求助）.rar (8.73 KB, 下载次数: 75)

2013-12-22 11:24 上传

点击文件名下载附件

该贴已经同步到 zhaogang1960的微博

ahyyf

谢谢赵教师。很好，用公式有时会因为剪切而出现错误，这样就方便了。辛苦您了！

ahyyf

赵教师：还要打扰您，表格中名单后面的行中还有公式，所以在无人员信息的行中也出现“填重复了，请核实。”字样，能否在姓名为空的情况下不出现“填重复了，请核实。”，谢谢！
人员信息表（求助）2.rar (8.9 KB, 下载次数: 21)

2013-12-22 13:00 上传

点击文件名下载附件

zhaogang1960

ahyyf 发表于 2013-12-22 13:01
赵教师：还要打扰您，表格中名单后面的行中还有公式，所以在无人员信息的行中也出现“填重复了，请核实。” ...

再加一个判断：

1. Sub Macro1()
   
2.     Dim arr, brr$(), i&
   
3.     arr = Range("A1").CurrentRegion
   
4.     ReDim brr(2 To UBound(arr), 1 To 1)
   
5.     For i = 2 To UBound(arr)
   
6.         If Len(arr(i, 4)) Then
   
7.             If arr(i, 4) = arr(i, 6) Then brr(i, 1) = "填重复了，请核实。"
   
8.         End If
   
9.     Next
   
10.     [h2].Resize(i - 2) = brr
    
11. End Sub
    

复制代码

ndyzx

zhaogang1960 发表于 2013-12-22 13:06
再加一个判断：

学习了，记住位子。