从字符串返回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