[已解决]在ET3:ET12中选择离EP1第一个数最近的4个数，并连同该数填色

爱疯

Sub Click()
    Dim rng As Range
    Dim x As Integer    '起点
    Dim y As Integer    '终点
    Dim z As Integer    '目标的行号
   
    '1）找目标
    Set rng = Range("et3:et12")
    rng.Interior.ColorIndex = xlNone
    z = rng.Find(Left([ep1], 1)).Row
   
    '2）确定新起点和新终点
    x = z - 2: y = z + 2                        '连续
    If z < 5 Then x = 3: y = z + 2 - (z - 5)    '不连续，上半不够，找新终点
    If z > 10 Then x = z - 2 - (z - 10): y = 12 '不连续，下半不够，找新起点
   
    '3)填色
    Range(Cells(x, rng.Column), Cells(y, rng.Column)).Interior.ColorIndex = 4
End Sub


下班了，来不急测试，你多测下

wszbd

爱疯 发表于 2014-1-16 17:18
Sub Click()
    Dim rng As Range
    Dim x As Integer    '起点

ok，老师真棒！！！

还有一个问题：如果“在ET3：ET12中选择离EP1第二个数最近的4个数，连同这个数同时翻为淡蓝色”怎么修改？

谢谢！！！

爱疯

z = rng.Find(mid([ep1], 2,1)).Row

wszbd

爱疯 发表于 2014-1-16 17:29
z = rng.Find(mid([ep1], 2,1)).Row

还有一个问题：如果“在ET3：ET12中选择离EP1第一个数最近的2个数，连同这个数同时翻为淡蓝色”怎么修改？

谢谢！！！

爱疯

改的地方有点多，手机不好回复，晚上有事，有空回

wszbd

爱疯 发表于 2014-1-16 17:41
改的地方有点多，手机不好回复，晚上有事，有空回

是不是这样改：x = z - 1: y = z + 1  貌似对了。


谢谢！！！

爱疯

'最近2个
Sub Click2()
    Dim rng As Range
    Dim x As Integer    '起点
    Dim y As Integer    '终点
    Dim z As Integer    '目标的行号
   
    '1）找目标
    Set rng = Range("et3:et12")
    rng.Interior.ColorIndex = xlNone
    z = rng.Find(Left([ep1], 1)).Row
   
    '2）确认边界
    x = z - 1: y = z + 1
    If z < 4 Then x = 3: y = y - (z - 4)
    If z > 11 Then x = x - (z - 11): y = 12
   
    '3)填色
    Range(Cells(x, rng.Column), Cells(y, rng.Column)).Interior.ColorIndex = 4
End Sub
填色3.rar (12.08 KB, 下载次数: 2)

2014-1-16 19:37 上传

点击文件名下载附件

wszbd

爱疯 发表于 2014-1-16 19:37
'最近2个
Sub Click2()
    Dim rng As Range

太棒了，谢谢！！！


这句代码那个地方错了：Set x = rng.Find(Mid([ep1], 2, 1)).Row   请老师赐教。

wszbd

爱疯 发表于 2014-1-16 19:37
'最近2个
Sub Click2()
    Dim rng As Range

这个该两个数，是不是这样改：

Sub Click()
    Dim rng As Range    '查找范围
    Dim x As Range      '（临时）目标
    Dim y As Range      '目标备份
    Dim z As Range      '目标集合
    Dim i As Integer

    '1）找目标单元格
    Set rng = Range("et3:et12")
    Set x = rng.Find(Left([ep1], 1))
    Set z = x: Set y = x
    Debug.Print x.Address

    '2)目的单元格之前的
    ‘For i = 1 To 2
        Set x = rng.Find("*", x, , , , xlPrevious)
        Debug.Print x.Address
        Set z = Union(z, x)
    ’Next i

    '3)目的单元格之后的
    Set x = y
    ‘For i = 1 To 2
        Set x = rng.Find("*", x, , , , xlNext)
        Debug.Print x.Address
        Set z = Union(z, x)
   ’ Next i
   
    '4）填充
    z.Interior.ColorIndex = 4
End Sub

爱疯

填色4.rar (11.94 KB, 下载次数: 4)

2014-1-16 20:48 上传

点击文件名下载附件

合在一起了。
见注释，手动修改m或n