[英]Excel VBA creating a Hyperlink to the same cell
我有一個工作表,其中的字符串“ Title”在B列中重復了幾次。對於“ Title”的每個實例,我想在該值的直接下一行放置一個指向同一單元格的超鏈接(即,如果title在B1中,我想B2中的超鏈接)。
因此,如果超鏈接有效地位於B2中,則單擊該鏈接時只會在同一單元格上說什么。
但是,我需要更改單元格B2中的現有值,所有要做的就是將其從常規值更改為超鏈接值。
以下是到目前為止我要提出的內容,請記住,VBA尚不成熟,因此對指針表示贊賞。
Sub RunThis()
'Declare workbook and worksheets:
Dim mainFile As Workbook, titleDetailSheet As Worksheet
Set mainFile = ActiveWorkbook
Set titleDetailSheet = mainFile.Sheets("Title Detail")
Dim searchString As String
searchString = "Title"
For r = 1 To 200
If titleDetailSheet.Range("B" & r) = searchString Then
titleDetailSheet.Range("B" & r + 1) = **'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=titleDetailSheet.Name & "!A1", TextToDisplay:="Title"**
End If
Next r
End Sub
我不確定粗體腳本的正確語法是什么。
你需要這樣的東西
If titleDetailSheet.Range("B" & r) = searchString Then
mainFile.ActiveSheet.Hyperlinks.Add _
Anchor:=titleDetailSheet.Range("B" & r + 1), _
Address:="", _
SubAddress:="'" & titleDetailSheet.Name & "'!" & titleDetailSheet.Range("B" & r).Address, _
TextToDisplay:=titleDetailSheet.Range("B" & r + 1).Value
End If
請看看您是否能理解語法,然后問我是否有不清楚的項目。 ^ - ^
在
Set mainFile = ActiveWorbook
您拼錯了Activeworkbook。
那個部分
SubAddress:=titleDetailSheet.Name & "!A1"
是一個棘手的問題:
SubAddress:="'" & titleDetailSheet.Name & "'!A1"
您的變量長一英里。 嘗試縮短它們。
Option Explicit
'With Project ==================================================================
' .Title: HyperlinkBColumn
' .Author: YMG
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' With .Contents
' Sub HyperlinkBColumn
' End With
'===============================================================================
'
'-------------------------------------------------------------------------------
Sub HyperlinkBColumn()
'
'Description:
' Loops through a specified column and when a specified value is found, puts
' a hyperlink in the cell below.
'Arguments
' None
'Returns
' Hyperlinks on worksheet, Debugging info in the Immediate Window
'
'--Customize BEGIN ---------------------
Const cWsName As String = "Title Detail"
Const cSearch As String = "Title"
Const cRow1 As Integer = 1
Const cRow2 As Long = 200
Const cCol As String = "B"
Const cHeader As String = "Processing rows..." 'Immdediate Window
Const cFooter As String = "...finished processing." 'Immediate Window
'--Customize END -----------------------
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim oWb As Workbook
Dim oWs As Worksheet
Dim rCell1 As Range
Dim rCell2 As Range
Dim iR As Integer
Dim strText As String
Dim strAddr As String
Dim str1 As String 'Immediate Window
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set oWb = ActiveWorkbook
Set oWs = oWb.Worksheets(cWsName)
For iR = cRow1 To cRow2
Set rCell1 = oWs.Range(cCol & iR)
Set rCell2 = oWs.Range(cCol & iR + 1)
strText = rCell2.Text 'What's written in the cell.
strAddr = rCell2.Address 'The address e.g. B1, B13 ...
If rCell1 = cSearch Then
If strText <> "" Then
'Anchor is the place where to put the hyperlink, cell or object.
'Notice the single quotes (') in the SubAddress.
'Readability is very important, notice every argument on its own line.
'It's much easier to find a mistake.
rCell2.Hyperlinks.Add _
Anchor:=rCell2, _
Address:="", _
SubAddress:="'" & oWs.Name & "'!" & strAddr, _
TextToDisplay:=strText 'The same text as requested
str1 = str1 & vbCrLf & iR & ". " & rCell1.Address & " " _
& strText & " - at " & strAddr 'Immediate Window
Else
'Put in here what to do if the cell below the Title cell is empty.
'I've chosen to skip the line.
End If
End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
str1 = cHeader & str1 & vbCrLf & cFooter 'Immediate Window
Debug.Print str1 'Immediate Window
'
End Sub
'-------------------------------------------------------------------------------
'
'With Idea Source --------------------------------------------------------------
' .Title: Excel VBA creating a Hyperlink to the same cell
' .TitleURL: https://stackoverflow.com/questions/52527595/excel-vba-creating-a-hyperlink-to-the-same-cell
' .Author: Nayan
' .AuthorURL: https://stackoverflow.com/users/10416060/nayan
'End With ----------------------------------------------------------------------
'
'End With ======================================================================
僅一個問題:為什么要創建超鏈接以指向它所在的相同單元格?
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.