ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
12
返回列表 发新帖
楼主: 缔造者

[求助] 数据有效性与超链接(动态超链接)

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-8-8 18:06 | 显示全部楼层
xiaoyaoyao13 发表于 2015-8-7 23:49
题主,我把科目表复制了一份到A39:A75作为公式之辅助。
A2:
数组公式三键,下拉到A38

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

TA的精华主题

TA的得分主题

发表于 2015-8-8 20:57 | 显示全部楼层
缔造者 发表于 2015-8-8 18:06
不好意思啊,区域写错了,抱歉!
更正为:另外有个想法,能否实现?当B3:Y3,B37:Y37和B71:Y71区域选 ...

这个好像用公式不太好实现哈,不好意思了~

TA的精华主题

TA的得分主题

发表于 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, 下载次数: 27)

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-8-10 08:44 | 显示全部楼层
uneye2 发表于 2015-8-8 23:49
只有三个区域,改一下参数就可以。点击标题返回顶端。

达不到预期效果!谢谢!

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-8-10 19:02 | 显示全部楼层
chxw68 发表于 2015-8-7 19:32
感觉不是太完美,供楼主参考吧。

完善了一下VBA法,再次表示感谢!
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Target.Count > 1 Then Exit Sub
  3.     If Not Application.Intersect(Target, Union(Range("B3:Y3"), Range("B37:Y37"), Range("B71:Y71"))) Is Nothing Then
  4.         Dim i%, j%, arr, d As Object
  5.         Set d = CreateObject("scripting.dictionary")
  6.         arr = Range("a2:a38")
  7.         For i = 1 To UBound(arr)
  8.             Set d(arr(i, 1)) = Cells(i + 1, 1)
  9.         Next
  10.         Application.EnableEvents = False
  11.         For i = 2 To 38
  12.             Cells(i, 1).Hyperlinks.Delete
  13.         Next
  14.         For i = 3 To 71 Step 34
  15.             For j = 2 To 22 Step 4
  16.                 If d.exists(Cells(i, j).Value) And Cells(i, j) <> "" Then
  17.                     ActiveSheet.Hyperlinks.Add Anchor:=d(Cells(i, j).Value), Address:="", SubAddress:=ActiveSheet.Name & "!" & Cells(i, j).Address(0, 0), TextToDisplay:=Cells(i, j).Value
  18.                 End If
  19.             Next
  20.         Next
  21.         Range("a1:a38").Font.Size = 9
  22.         Application.EnableEvents = True
  23.         Set d = Nothing
  24.     End If
  25. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-8-10 19:08 | 显示全部楼层
VBA法和公式法参见附件:
求助超链接.rar (15.76 KB, 下载次数: 40)
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-2-22 21:38 , Processed in 0.365461 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表