从字符串返回Range的一个很实用的VBA Range函数

Excel的VBA编程中，很常用到的是通过字符串返回Range的功能，然后进一步对Range操作，这里水文工具集介绍一个实用的VBA Range函数RangeFromAddress，具体源代码如下：

'================================
' VBA中从字符串返回Range
'
' 
'================================
Function RangeFromAddress( _
 ByRef Address As String, _
 Optional obj As Object) As Range
    Dim Wb As Workbook, FallbackWb As Workbook
    Dim sh As Worksheet, FallbackSh As Worksheet
    Dim w, s, a As String
    Dim i As Long, j As Long
    Dim n As Name
    
    On Error Resume Next
    
    Set n = Names(Address)
    If Not (n Is Nothing) Then
        Set RangeFromAddress = n.RefersToRange
        Exit Function
    End If
    
    
    If Not (obj Is Nothing) Then
        Set FallbackWb = GetObjectParentWorkbook(obj)
        Set FallbackSh = GetObjectParentSheet(obj)
    Else
        Set FallbackWb = ActiveWorkbook
        Set FallbackSh = ActiveSheet
    End If
    
    i = InStr(Address, "!")
    If i = 0 Then
        Set RangeFromAddress = FallbackSh.Range(Address)
    Else
        s = Left$(Address, i - 1)
        a = Mid$(Address, i + 1)
        If InStr(s, "'") = 1 Then
            s = Mid$(s, 2, Len(s) - 2)
        End If
        
        i = 1
        Do Until i > Len(s)
            If Mid$(s, i, 2) = "''" Then
                s = Left$(s, i - 1) & Mid$(s, i + 1)
            End If
            i = i + 1
        Loop
        
        i = InStr(s, "]")
        If i = 0 Then
            Set sh = FallbackWb.Sheets(s)
        Else 
            w = Left$(s, i - 1)
            j = InStr(w, "[")
            If j <> 0 Then w = Left$(w, j - 1) & Mid$(w, j + 1)
            s = Mid$(s, i + 1)
            
            Set Wb = Workbooks(w)
            If Wb Is Nothing Then
                DisplayAlertsOff
                Set Wb = Workbooks.Open(FileName:=w, Notify:=True)
                DisplayAlertsOn
            End If
            Set sh = Wb.Sheets(s)
        End If
        Set RangeFromAddress = sh.Range(a)
    End If
End Function

上面的RangeFromAddress还引用到两个函数，具体代码如下：

Function GetObjectParentSheet(aObject As Object) As Object
    Dim op As Object
    On Error Resume Next

    If aObject Is Nothing Then GoTo ErrorExit
    Set op = aObject.Parent
    If op Is Nothing Then GoTo ErrorExit
    
    If TypeOf op Is Workbook Then
        Set GetObjectParentSheet = aObject
        GoTo ErrorExit
    End If
    
    Do Until (TypeOf op Is Worksheet) Or (TypeOf op Is Application)
        Set op = op.Parent
    Loop
    
    If TypeOf op Is Worksheet Then Set GetObjectParentSheet = op

ErrorExit:
    Exit Function
End Function


Function GetObjectParentWorkbook(aObject As Object) As Workbook
    Dim o As Object
    
    On Error GoTo ErrorHandle

    If aObject Is Nothing Then GoTo ErrorExit
    Set o = aObject.Parent
    
    If TypeOf aObject Is Workbook Then
        Set GetObjectParentWorkbook = aObject
        GoTo ErrorExit
    End If
    
    Do Until (TypeOf o Is Workbook) Or (TypeOf o Is Application)
        Set o = o.Parent
    Loop

    If TypeOf o Is Workbook Then Set GetObjectParentWorkbook = o

ErrorExit:
    Exit Function
    
ErrorHandle:
    Resume ErrorExit
End Function