简体   繁体   中英

How do I get the worksheet referenced by a cell formula

Function LinkedSheet(rgCell As Range) As Worksheet
'Returns the worksheet that the cell formula references
'Returns nothing if there's no formula
    Dim strFormula As String

    strFormula = rgCell.Cells(1, 1).Formula

    If (strFormula <> "") Then
        'Return the sheet that this range is linked to
    End If
End Function

Can someone help me complete this function? Keep in mind that this should work for internal links, external links, and links to sheets with a space in the name like "Sheet 1"

Edit: In response to Siddharth Rout, I have previously tried

Function LinkedSheet(rgCell As Range) As Worksheet
'Returns the worksheet that the cell formula references
'Returns nothing if there's no formula
    Dim strFormula As String, sheetName As String

    strFormula = rgCell.Cells(1, 1).Formula

    If (strFormula <> "") Then
        'Return the sheet that this range is linked to
        sheetName = Mid(strFormula, 2, InStr(1, strFormula, "!") - 2)
        Set LinkedSheet = ThisWorkbook.Worksheets(sheetName)
    End If
End Function

which fails for sheets with a space in the name. However, I was reluctant to post this because I feel there must be a better, more efficient way of tackling the problem and I didn't want to tunnel people's thought in the same direction that I went.

Here's my solution

Function LinkedSheet(rgCell As Range) As Worksheet
'Returns the worksheet that the cell formula references
'Returns nothing if there's no formula
    Dim strFormula As String, sheetName As String

    strFormula = rgCell.Cells(1, 1).Formula

    If (strFormula <> "") Then
        'Return the sheet that this range is linked to
        If (InStr(1, strFormula, "='") = 0) Then
            sheetName = Mid(strFormula, 2, InStr(1, strFormula, "!") - 2)
        Else
            sheetName = Mid(strFormula, 3, InStr(1, strFormula, "!") - 4)
        End If
        Set LinkedSheet = ThisWorkbook.Worksheets(sheetName)
    End If
End Function

I'm not totally pleased with it. I still think there may be better approaches, but this works.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM