样本1.rar
(7.84 KB, 下载次数: 3)
Private Sub Worksheet_Change(ByVal Target As Range )
If Target.Count > 1 Or Target.Column <> 2 Then Exit Sub
Application.EnableEvents = False
Dim Ro&, Rng As Range , I%, J%, F As Boolean , A
Ro = ActiveSheet.UsedRange.Rows.Count - 1 + ActiveSheet.UsedRange.Row
On Error GoTo ex
Target.Offset(1, 1) = (Left(Target, 1) + 1) Mod 10
'0对013,1对124,2对235,3对346,4对457,5对568,6对679,7对780,8对891,9对902
Target.Offset(1, 2) = Choose(Target.Offset(1, 1) + 1, "0 1 3", "1 2 3", "2 3 5", "3 4 6", "4 5 7", "5 6 8", "6 7 9", "7 8 0", "8 9 1", "9 0 2")
Target.Offset(1, 4) = (Mid(Target, 3, 1) + 1) Mod 10
Target.Offset(1, 5) = Choose(Target.Offset(1, 4) + 1, "0 1 3", "1 2 3", "2 3 5", "3 4 6", "4 5 7", "5 6 8", "6 7 9", "7 8 0", "8 9 1", "9 0 2")
Target.Offset(1, 7) = (Right(Target, 1) + 1) Mod 10
Target.Offset(1, 8) = Choose(Target.Offset(1, 7) + 1, "0 1 3", "1 2 3", "2 3 5", "3 4 6", "4 5 7", "5 6 8", "6 7 9", "7 8 0", "8 9 1", "9 0 2")
' 三个数字对应的号码互不包含则显示为黄色,如果包含有号码的号则对应的数字显示为红色
For I = 1 To 3
Set Rng = Target.Offset(0, (I - 1) * 3 + 2)
For J = 1 To 5 Step 2
A = Mid(Rng.Text, J, 1)
If InStr(1, Target, A) > 0 Then
F = True
Rng.Characters(J, 1).Font.Color = vbRed
Else
F = False
End If
Next
If Not F Then Rng.Interior.Color = vbYellow
Next
ex:
Application.EnableEvents = True
End Sub
以上代码在附件1中运行,则只能手动填入数据,代码才能执行.如果是大量的粘贴数据到A列和B列,则代码不执行.其后的参数也不作变化,请修改为无论怎样填入数据,其后的列都有变化.
其二,数据更新后,位于B列的号码和后面D,G,J 三列变化后的对应数,格式条件对不上,后三列分别与B列相比较后,如果有任意一数字相同,则不显示黄色,而有相同的数字显示为红色.而没有任何数字相同,即互不包含,才显示黄色.代码中这点不正确.胡乱显示.请修改.
如对表1看不明白,请参考带公式的表2,下拉即可得答案
样本2.rar
(4.56 KB, 下载次数: 3)
[ 本帖最后由 exceliloveyou 于 2009-7-16 23:26 编辑 ] |
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2009-7-16 15:48
楼主