想要一个excel公式或vba用于跨多个工作表相同单元格的链接单元格 [英] want a excel formula or vba for link cells across multiple sheets same cell

问题描述

我有一个工作表名称''sub''它有一个coulmn它的单元格是a1，a2，a3，a4 ........

另一个工作表名称''Stu有1到100张。我想链接sheet1 b3中的a1数据，sheet2 b3中的a2单元格数据，sheet3 b3中的a3单元格数据...............

请帮助

解决方案

试试这个：

 < span class =code-keyword>选项 明确 
 
 
  Sub  AddLinks（）
  Dim  srcWbk 作为工作簿，dstWbk 作为工作簿
  Dim  srcWsh 作为工作表， dstWsh 作为工作表
  Dim  i  As  整数，j  As  整数，hl 作为超链接
 
 开启 错误  GoTo  Err_AddLinks 
 
 设置 srcWbk = ThisWorkbook 
 设置 srcWsh = srcWbk.Worksheets（   Sheet1）
 
 ' 如果工作簿已经打开 
 设置 dstWbk = Application.Workbooks（  Book2.xls）
 ' 如果工作簿已关闭 
 ' 设置dstWbk = Application.Workbooks.Open（FullFileName ） 
 
i =  1  
 执行   srcWsh.Range（  B& i）<>   
 设置 dstWsh = dstWbk.Worksheets（i）
  Set  hl = dstWsh.Hyperlinks.Add（Anchor：= srcWsh.Range（  B& i），_ 
地址：= dstWbk.FullName，SubAddress：= dstWsh.Name&  ！& dstWsh.Range（ < span class =code-string> B3）。地址，_ 
 TextToDisplay：=  链接到：& dstWsh.Range（  B3）。地址）
 '  hl.Follow NewWindow：= True'在新窗口中打开链接 
i = i +  1  
 循环 
 
 
 Exit_AddLinks：
  On  错误 < span class =code-keyword> Resume   Next  
  Set  srcWbk = 没什么 
 设置 srcWsh = 没什么 
 设置 dstWbk = 没什么 
 设置 dstWsh =  Nothing  
 设置 hl =  Nothing  
 退出  Sub  
 
 Err_AddLinks：
 MsgBox Err.Description，vbExclamation，Err.Number 
  Resume  Exit_AddLinks 
 
 结束  Sub < /跨度> 

i have a sheet name ''sub'' it has A coulmn its cell are a1,a2,a3,a4........
another worksheet name ''Stu" has 1 to 100 sheets . I want to link a1 data in sheet1 b3, a2 cell data in sheet2 b3, a3 cell data in sheet3 b3...............
pls help help

解决方案

Try this:

Option Explicit


Sub AddLinks()
Dim srcWbk As Workbook, dstWbk As Workbook
Dim srcWsh As Worksheet, dstWsh As Worksheet
Dim i As Integer, j As Integer, hl As Hyperlink

On Error GoTo Err_AddLinks

Set srcWbk = ThisWorkbook
Set srcWsh = srcWbk.Worksheets("Sheet1")

'if workbook is already open
Set dstWbk = Application.Workbooks("Book2.xls")
'if workbook is closed
'Set dstWbk = Application.Workbooks.Open("FullFileName")

i = 1
Do While srcWsh.Range("B" & i) <> ""
    Set dstWsh = dstWbk.Worksheets(i)
    Set hl = dstWsh.Hyperlinks.Add(Anchor:=srcWsh.Range("B" & i), _
            Address:=dstWbk.FullName, SubAddress:=dstWsh.Name & "!" & dstWsh.Range("B3").Address, _
            TextToDisplay:="link to: " & dstWsh.Range("B3").Address)
    'hl.Follow NewWindow:=True 'open link in new window
    i = i + 1
Loop


Exit_AddLinks:
    On Error Resume Next
    Set srcWbk = Nothing
    Set srcWsh = Nothing
    Set dstWbk = Nothing
    Set dstWsh = Nothing
    Set hl = Nothing
    Exit Sub

Err_AddLinks:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_AddLinks

End Sub

这篇关于想要一个excel公式或vba用于跨多个工作表相同单元格的链接单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！