数据有效性与超链接（动态超链接）

缔造者 · 发表于 2015-8-8 18:06

xiaoyaoyao13 发表于 2015-8-7 23:49
题主，我把科目表复制了一份到A39:A75作为公式之辅助。
A2：
数组公式三键，下拉到A38

不好意思啊，区域写错了，抱歉！
更正为：另外有个想法，能否实现？当B3：Y3，B37：Y37和B71：Y71区域选择了A39：A75的值时则超链接，否则不超链接（也就是点击时不弹出超链接提示，同时右键放在上面也不显示提示）。
再次恳请你的帮忙，谢谢！

xiaoyaoyao13 · 发表于 2015-8-8 20:57

缔造者发表于 2015-8-8 18:06
不好意思啊，区域写错了，抱歉！
更正为：另外有个想法，能否实现？当B3：Y3，B37：Y37和B71：Y71区域选 ...

这个好像用公式不太好实现哈，不好意思了～

uneye2 · 发表于 2015-8-8 23:49

本帖最后由 uneye2 于 2015-8-8 23:58 编辑

缔造者发表于 2015-8-8 16:47
谢谢你！
公式=IF(ISERROR(MATCH(AD17,$B$3:$Y$3,0)),AD17,HYPERLINK("求助超链接.xls#Sheet1!"&CHAR(MA ...

只有三个区域，改一下参数就可以。点击标题返回顶端。

求助超链接.rar (12.31 KB, 下载次数: 28)

缔造者 · 发表于 2015-8-10 08:44

uneye2 发表于 2015-8-8 23:49
只有三个区域，改一下参数就可以。点击标题返回顶端。

达不到预期效果！谢谢！

缔造者 · 发表于 2015-8-10 19:02

chxw68 发表于 2015-8-7 19:32
感觉不是太完美，供楼主参考吧。

完善了一下VBA法，再次表示感谢！

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, Union(Range("B3:Y3"), Range("B37:Y37"), Range("B71:Y71"))) Is Nothing Then
Dim i%, j%, arr, d As Object
Set d = CreateObject("scripting.dictionary")
arr = Range("a2:a38")
For i = 1 To UBound(arr)
Set d(arr(i, 1)) = Cells(i + 1, 1)
Next
Application.EnableEvents = False
For i = 2 To 38
Cells(i, 1).Hyperlinks.Delete
Next
For i = 3 To 71 Step 34
For j = 2 To 22 Step 4
If d.exists(Cells(i, j).Value) And Cells(i, j) <> "" Then
ActiveSheet.Hyperlinks.Add Anchor:=d(Cells(i, j).Value), Address:="", SubAddress:=ActiveSheet.Name & "!" & Cells(i, j).Address(0, 0), TextToDisplay:=Cells(i, j).Value
End If
Next
Next
Range("a1:a38").Font.Size = 9
Application.EnableEvents = True
Set d = Nothing
End If
End Sub

复制代码

缔造者 · 发表于 2015-8-10 19:08

VBA法和公式法参见附件：

求助超链接.rar (15.76 KB, 下载次数: 62)

		自动登录	找回密码
密码			免费注册

[求助] 数据有效性与超链接（动态超链接）