单击公式所在单元格，光标就会自动定位到指定位置

WYS67

yjh_27 发表于 2020-3-1 17:37
自定义函数无法实现

老师：2楼或3楼的代码，点击J4时，光标跳到了J100【有公式存在的最后单元格】，而没有按照要求始终定位在J77【可见结果最后行的下一个单元格里】，麻烦老师看看怎样修改？

附：3楼代码

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$J$4" Then Target(Range("J65536").End(xlUp).Row - 3, 1).Select
    If Target.Address = "$I$4" Then Target(2, 2).Select
End Sub

yjh_27

WYS67 发表于 2020-3-1 19:40
老师，发现把2楼或3楼的代码粘贴进sheet1后，点击J4，光标都是跳至J100--我需要的是：点击J4，光标总 ...

1. <blockquote>Private Sub Worksheet_SelectionChange(ByVal Target As Range)

复制代码

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Address = "$J$4" Then
   
3.         r = Range("j" & Rows.Count).End(xlUp).Row
   
4.         Do While Range("j" & r) = ""
   
5.             r = r - 1
   
6.             If j = 5 Then Exit Do
   
7.         Loop
   
8.         Range("j" & r).Select
   
9.     End If
   
10.     If Target.Address = "$I$4" Then Range("j5").Select
    
11. End Sub

复制代码

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Address = "$J$4" Then
   
3.         r = 100
   
4.         Do While Range("j" & r) = ""
   
5.             r = r - 1
   
6.             If j = 5 Then Exit Do
   
7.         Loop
   
8.         Range("j" & r).Select
   
9.     End If
   
10.     If Target.Address = "$I$4" Then Range("i5").Select
    
11. End Sub

复制代码

YZC51

WYS67 发表于 2020-3-1 19:50
老师：2楼或3楼的代码，点击J4时，光标跳到了J100【有公式存在的最后单元格】，而没有按照要求始终定位在 ...

请参考
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    myr = Range("J6:J65535").Find("*", SearchDirection:=xlPrevious).Row
    If Target.Address = "$J$4" Then Cells(myr, 10).Select
    If Target.Address = "$I$4" Then Target(2, 2).Select
End Sub

YZC51

或者
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    myr = Range("J6:J65536").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Target.Address = "$J$4" Then Cells(myr, 10).Select
    If Target.Address = "$I$4" Then Target(2, 2).Select
End Sub

YZC51

再者
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$J$4" Then Sheet1.dw
    If Target.Address = "$I$4" Then Target(2, 2).Select
End Sub

Public Function dw()
    myr = Range("J6:J65536").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("J" & myr).Select
End Function

WYS67

YZC51 发表于 2020-3-1 21:07
再者
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$J$4" T ...

感谢谢老师一天来的耐心帮助！

WYS67

yjh_27 发表于 2020-3-1 20:14

两个代码都可以实现我想要的功能，谢谢老师！！！

WYS67

YZC51 发表于 2020-3-1 21:07
再者
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$J$4" T ...

23~25楼的三个代码都可以实现我想要的功能，很强大，谢谢老师！只能明天再补送花花了！

YZC51

WYS67 发表于 2020-3-1 22:11
23~25楼的三个代码都可以实现我想要的功能，很强大，谢谢老师！只能明天再补送花花了！

不客气！能用就好！

lss001

WYS67 发表于 2020-3-1 22:11
23~25楼的三个代码都可以实现我想要的功能，很强大，谢谢老师！只能明天再补送花花了！

添加为加载项的例子 >>>
Documents.rar (34.43 KB, 下载次数: 11)

2020-3-3 13:49 上传

点击文件名下载附件

'模块1代码>>>
Public a1, b1, c1, d1
Function GBDW(Optional a = "", Optional b = "", Optional c = "", _
        Optional d = "", Optional e = "") '自定义超链接公式
    If a = "" Then a1 = 2 Else a1 = a
    b1 = b:  c1 = c: d1 = d
    If e = "" Then e1 = IIf(a1 = 1, "返回首行", "最后数据") Else e1 = e
    GBDW = e1
End Function
Sub gbdws(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Target.Row < 5 Then
        If Mid(Target.Formula, 1, 5) = "=GBDW" Then '判断是否为超链接公式！
            x = Target.Address(0, 0): Set Rng = Range(x)
            If b1 = "" Then b = Rng.Row + 1 Else b = b1
            If c1 = "" Then c = Rows.Count Else c = c1
            If d1 = "" Then d = Rng.Column Else d = Cells(1, d1).Column
            If b = c Then b = b + 1
            m = Range(Sh.Cells(c, d), Sh.Cells(b, d).Address(0, 0)).Find("*", _
            LookIn:=-4163, SearchOrder:=1, SearchDirection:=2).Row
            If a1 = 1 Then '建立超链接
                Sh.Hyperlinks.Add Sh.Range(x), "#" & Cells(c, d).Address(0, 0)
            Else
                Sh.Hyperlinks.Add Sh.Range(x), "#" & Cells(m + 1, d).Address(0, 0)
            End If
        Else
            Set t = Target.Dependents '相关单元格
            For Each r In t
                s = r.Formula: Range(r.Address).Formula = s
            Next
        End If
    Else: Exit Sub
    End If
End Sub