EXCEL添加链接

最新推荐文章于 2024-10-01 05:04:32 发布

weixin_33775572

最新推荐文章于 2024-10-01 05:04:32 发布

阅读量131

点赞数

文章标签： python

原文链接：https://my.oschina.net/tedzheng/blog/1580227

版权

2019独角兽企业重金招聘Python工程师标准>>>

'添加链接
Sub Add_Hyperlink_by_CC()
Dim Dic As Object
Dim i, m
Dim arr
Dim Sk$
Dim Sht$
Dim ShName$
Dim ws As Worksheet
Dim TmpTxt$
'-----------------------------------------------------------
arr = Sheets("CC").UsedRange
Set Dic = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(arr)
    Sk = arr(i, 2)
    If arr(i, 18) = "X" Then          '需要操作工作表标志
        Dic(Sk) = ""
    End If
Next i
'-----------------------------------------------------------
Sht = "Summary 2018"
With Sheets(Sht)
   For m = 2 To .Cells(65536, 1).End(xlUp).Row
       TmpTxt = .Cells(m, 1)            '原始文本
       If Dic.Exists(TmpTxt) Then
           .Cells(m, 1).Hyperlinks.Delete
        ShName = TmpTxt                'Key
        '添加工作表链接
        '名称需加' '
            For Each ws In Worksheets
                If ws.Name = ShName Then
                Sheets(Sht).Hyperlinks.Add Anchor:=Sheets(Sht).Cells(m, 1), Address:="", SubAddress:= _
                      "'" & ws.Name & "'" & "!A1"
                     '添加返回链接
                       With ws
                          .Hyperlinks.Add Anchor:=.Cells(1, 1), Address:="", SubAddress:="'Summary 2018'!A" & m
                       End With
                       Exit For
                End If
            Next
       End If
   Next m
End With
MsgBox ("Done")
End Sub

转载于:https://my.oschina.net/tedzheng/blog/1580227