看看这段代码,如何能更佳达到运行的要求?

exceliloveyou

样本1.rar (7.84 KB, 下载次数: 3)

2009-7-16 23:26 上传

点击文件名下载附件

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)

2009-7-16 23:26 上传

点击文件名下载附件

[ 本帖最后由 exceliloveyou 于 2009-7-16 23:26 编辑 ]

exceliloveyou