根据指定的工作簿名称、表名，返回二维数组【通用】

lsdongjh

1. Sub Test()
   
2.     Dim arrData As Variant
   
3.    
   
4.     If GetDataByFilePath(ThisWorkbook.Path & Application.PathSeparator & "数据.xlsx", "Format", arrData) Then
   
5.         MsgBox "提取数据" & UBound(arrData) & "行" & UBound(arrData, 2) & "列"
   
6.     Else
   
7.        MsgBox "无数据！"
   
8.     End If
   
9. End Sub
   
10. 
    
11. '根据指定的工作簿名称、表名，返回二维数组
    
12. ''' --strFilePathAndName   要提取数据的工作簿 全路径名称
    
13. ''' --strSheetName         要提取数据的工作表名
    
14. ''' --ArrResult            返回结果
    
15. Function GetDataByFilePath(strFilePathAndName As String, strSheetName As String, ByRef ArrResult As Variant) As Boolean
    
16.     Dim wb As Workbook, varTmp As Variant
    
17.     On Error GoTo ExitFun
    
18.     Set wb = GetObject(strFilePathAndName)
    
19.     ArrResult = wb.Sheets(strSheetName).UsedRange
    
20.     wb.Close (False)
    
21.     Set wb = Nothing
    
22.     If IsEmpty(ArrResult) Then GoTo ExitFun
    
23.     If Not IsArray(ArrResult) Then
    
24.         varTmp = ArrResult
    
25.         ReDim ArrResult(1 To 1, 1 To 1) As Variant
    
26.         ArrResult(1, 1) = varTmp
    
27.     End If
    
28.    
    
29.     GetDataByFilePath = True
    
30.     Exit Function
    
31. ExitFun:
    
32.     If Not (wb Is Nothing) Then wb.Close (False)
    
33.     Set wb = Nothing
    
34.     GetDataByFilePath = False
    
35. End Function

复制代码