如何获取在单元格中作为超链接链接的工作簿的特定单元格特定工作表？

Question

我有一个单元格范围，其中可以包含指向其他 Excel 数据的超链接。 ]()

我需要获取该超链接的特定工作表中的特定单元格。 我只是不知道如何到达那个牢房。

有人知道这个问题的语法吗？ 这可能吗？

我不知道如何获取该特定单元格，所以我首先尝试像这样拉动工作表： AktiveWorkbook.Sheets.添加之前：=c.Hyperlinks.Application.Worksheets(1)

最好的选择是我什至不必拉出工作表，但正如我所说，我没有任何线索。

回复评论：

我在一个工作簿中，在A1中可以找到值“C:\Users\z0\Downloads\GG.xlsm”，这是关闭的工作簿的路径。 我尝试获取已关闭工作簿的 Sheet1 的 A1 单元格作为示例，并将值粘贴到工作簿中的 B1，您还可以在其中找到路径。

我已经尝试过这个：

Dim wb As Workbook: Set wb = ThisWorkbook
Dim sh As Worksheet: Set sh = wb.Worksheets(1)
Dim cell As Range: Set cell = sh.Range("A1:A1000")
Dim pth As String
Dim qafWb As Workbook

pth = Replace(Range("A1").Value, "\", "/")
qafWb = Workbooks(pth)
sh.Range("B2") = qafWb.Worksheets(1).Range("G13")

编译器说变量 qafWb 确实包含“无”

我希望我能够表达我的需求:)

提前谢谢您

Answer 1

假设您的工作表中的单元格

A1

中有一个文件名，其路径例如

C:\Users\z0\Downloads\GG.xlsm

在

E1

中填写工作表的名称，例如

Sheet1

，在

F1

中单元格的地址，例如

A1

在

A4

中您要读取该值。 您可以使用这样的宏：

Sub ReadFromFile()
    Dim adr As String, path As String, filename As String
    Dim shname As String, celladr As String
    adr = Range("A1").Value
    path = Left(adr, InStrRev(adr, "\"))
    filename = Mid(adr, InStrRev(adr, "\") + 1)
    shname = Range("E1").Value
    celladr = Range("F1").Value
    On Error Resume Next
    Range("A4").Formula = "='" & path & "[" & filename & "]" & shname & "'!" & celladr
    On Error GoTo 0
End Sub

Answer 2

使用“超级”单元格 (VBA) 编写公式

Sub WriteFormulaUsingHyperCell()
    
    
    Const SRC_SHEET_NAME As String = "Sheet1"
    Const SRC_CELL As String = "C2"
    
    Const DST_SHEET_NAME As String = "Sheet1"
    Const DST_HYPER_CELL As String = "A1"
    Const DST_FORMULA_CELL As String = "B1"
    Const NOT_FOUND_STRING As String = "Not found"
    
    Dim IsSuccess As Boolean
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim dws As workseet: Set dws = wb.Sheets(DST_SHEET_NAME)
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim sStr As String: sStr = ws.Range(DST_HYPER_CELL).Formula
    
    
    Dim Parts() As String: Parts = Split(sStr, """")
    If UBound(Parts) < 1 Then GoTo WriteResult ' no double quotes
    
    Dim sFilePath As String: sFilePath = Parts(1)
    Dim Position As Long: Position = InStrRev(FilePath, "\")
    If Position = 0 Then GoTo WriteResult ' no backslashes
                
    Dim sFolderPath As String: sFolderPath = Left(sFilePath, Position)
    Dim sFileName As String:
    sFileName = Right(sFilePath, Len(sFilePath) - Position)
    
    Dim dFormula As String: dFormula = "='" & sFolderPath & "[" & sFileName _
        & "]" & SRC_SHEET_NAME & "'!" & SRC_CELL
    
    IsSuccess = True
    
    'Debug.Print sFilePath
    'Debug.Print sFileName
    'Debug.Print dFormula
    
WriteResult:
    
    With ws.Range(DST_FORMULA_CELL)
        If IsSuccess Then
            .Formula = Formula
        Else
            .Value = NOT_FOUND_STRING
        End If
    End With
    
End Sub