精品伊人久久大香线蕉,开心久久婷婷综合中文字幕,杏田冲梨,人妻无码aⅴ不卡中文字幕

打開APP
userphoto
未登錄

開通VIP,暢享免費電子書等14項超值服

開通VIP
Excel_VBA從關閉的工作簿中取值多種實現方法(代碼)
從有關的工作簿中取值有多種方法,現將網上收集的整理向大家共享。
方法 1、使用公式
方法 2、使用 GetObject 函數 、
 方法 3、隱藏 Application 對象
方法 4、使用 ExecuteExcel4Macro 方法
方法 5、使用 SQL 連接 1、使用公式 、 如果需要引用的數據不是太多,可以使用公式取得引用工作簿中的工作表數據,如下面的代碼所示。
 Sub CopyData_1()
    Dim Temp As String
   Temp = "'" & ThisWorkbook.Path & "¥[數據表.xls]Sheet1'!"
    With Sheet1.Range("A1:F22")
        .FormulaR1C1 = "=" & Temp & "RC"
       .Value = .Value
    End With
 End Sub
代碼解析: CopyData_1 過程在工作表中寫入公式引用“數據表”中同一位置單元格中的數據。 第 3 行代碼將引用工作簿的路徑賦給變量 Temp。 第 5 行代碼在作表中寫入公式引用數據。 第 6 行代碼將公式轉換為數值。
 
2、使用 GetObject 函數 、
使用 GetObject 函數來獲取對指定的 Excel 工作表的引用,如下面的代碼所示。
Sub CopyData_2()
   Dim Wb As Workbook
   Dim Temp As String
   Application.ScreenUpdating = False
   Temp = ThisWorkbook.Path & "¥數據表.xls"
   Set Wb = GetObject(Temp)
   With Wb.Sheets(1).Range("A1").CurrentRegion
       Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
       Wb.Close False
   End With
   Set Wb = Nothing
   Application.ScreenUpdating = True
End Sub
代碼解析: CopyData_2 過程使用 GetObject 函數來獲取“數據表”工作簿中的數據。 第 4 行代碼關關屏幕更新加快運行速度。 第 5 行代碼將引用工作簿的路徑賦給變量 Temp。 第 6 行代碼使用 Set 語句將 GetObject 函數返回的對象賦給對象變量 Wb。
GetObject 函數返回文件中的 ActiveX 對象的引用,語法如下:
GetObject([pathname] [, class])
參數 pathname 是可選的,包含待檢索對象的文件的全路徑和名稱。如果省略,則 class 參數是必需的。
參數 class 是可選的,代表該對象的類的字符串。 Class 參數的格式為 appname.objecttype,語法的各個部分如表格 1 所示。
   部分                  描述
appname        必需的,提供該對象的應用程序名稱。
objecttype      必需的,待創建對象的類型或類。
表格 1 Class 參數語法的各個部分
第 7 行到第 10 行代碼,當 GetObject 函數指定的對象被激活之后,就可以在代碼中使用對象變量 Wb 來訪問這個對象的屬性 和方法。 其中第 7、8 行代碼將“數據表”工作簿中的第 1 張工作表已使用區域的數據賦給本工作表的單元格,第 9 行代碼關關“數據表”工 作簿,使用 GetObject 函數返回對象的引用時,雖然在窗口中看不到對象的實例,但實際上是打開的,所以需用 Close 語句將 其關關。 第 12 行代碼開啟屏幕更新。
3、隱藏 Application 對象  通過隱藏 Application 對象來模擬不打開工作簿取數,如下面的代碼所示。
 Sub CopyData_3()
     Dim myApp As New Application
     Dim Sh As Worksheet
     Dim Temp As String T
     emp = ThisWorkbook.Path & "¥數據表.xls"
     myApp.Visible = False
     Set Sh = myApp.Workbooks.Open(Temp).Sheets(1)
     With Sh.Range("A1").CurrentRegion
         Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
      End With
      myApp.Quit
      Set Sh = Nothing
      Set myApp = Nothing
  End Sub
代碼解析: CopyData_3 過程隱藏 Application 對象來模擬不打開工作簿取數。 第 2 行代碼使用 New 關鍵字隱式地創建一個 Application 對象。 第 6 行代碼將新創建的 Application 對象的 Visible 屬性設置為 False,使之隱藏。 第 7 行代碼使用 Open 方法打開“數據表”工作簿(關于 Open 方法請參閱技巧 42 ,因為工作簿是使用新創建的、隱藏的 Application 對象打開的,所以在窗口中是不可視的。 第 8 行到第 10 行代碼將“數據表”工作簿中的第 1 張工作表已使用區域的數據賦給本工作表的單元格。 第 11 行代碼使用 Quit 方法退出新打開的 Excel 程序。
 
4、使用 ExecuteExcel4Macro 方法  使用 ExecuteExcel4Macro 方法可以做到不打開工作簿的情況下獲取其他工作薄中指定工作表的數據,如下面的代碼所示。
Sub CopyData_4()  
     Dim RCount As Long
     Dim CCount As Long
     Dim Temp As String
     Dim Temp1 As String
     Dim Temp2 As String
     Dim Temp3 As String
     Dim R As Long
     Dim C As Long
     Dim arr() As Variant
     Temp = "'" & ThisWorkbook.Path & "¥[數據表.xls]Sheet1'!"
     Temp1 = Temp & Rows(1).Address(, , xlR1C1)
     Temp1 = "Counta(" & Temp1 & ")"
     CCount = Application.ExecuteExcel4Macro(Temp1)
     Temp2 = Temp & Columns("A").Address(, , xlR1C1)
     Temp2 = "Counta(" & Temp2 & ")"
     RCount = Application.ExecuteExcel4Macro(Temp2)
     ReDim arr(1 To RCount, 1 To CCount)
     For R = 1 To RCount
         For C = 1 To CCount
            Temp3 = Temp & Cells(R, C).Address(, , xlR1C1)
            arr(R, C) = Application.ExecuteExcel4Macro(Temp3)
         Next
      Next Range("A1").Resize(RCount, CCount).Value = arr
 End Sub
代碼解析: CopyData_4 過程使用 ExecuteExcel4Macro 方法獲取“數據表”工作薄中指定工作表的數據。 第 14、16 行代碼使用 ExecuteExcel4Macro 方法執行 Counta 函數取得“數據表”工作薄中指定工作表的行數和列數合計。 ExecuteExcel4Macro 方法執行一個 Microsoft Excel 4.0 宏函數,然后返回此函數的結果,語法如下: expression.ExecuteExcel4Macro(String) 參數 expression 是可選的,返回一個 Application 對象。 參數 String 是必需的,一個不帶等號的 Microsoft Excel 4.0 宏語言函數,所有引用必須是像 R1C1 這樣的字符串。 因為 Microsoft Excel 4.0 宏不在當前工作簿或工作表的環境中求值,所有的引用都是外部引用,所以無需打開引用工作簿但是 需要明確指定工作簿名稱。 第 18 行代碼使用 ReDim 語句為動態數組 arr 重新分配存儲空間。 第 19 行到第 24 行代碼循環取值,將“數據表”工作薄中指定工作表的數據賦給動態數組 arr。 第 25 行代碼將動態數組 arr 的值賦給工作表的單元格。
 
5、使用 SQL 連接使用 SQL 建立與工作簿的連接,查詢數據記錄后復制到當前工作表中,如下面的代碼所示。
Sub CopyData_5() 
    Dim Sql As String
    Dim j As Integer
    Dim R As Integer
    Dim Cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    With Sheet5
        .Cells.Clear
        Set Cnn = New ADODB.Connection
        With Cnn
           .Provider = "microsoft.jet.oledb.4.0"
           .ConnectionString = "Extended Properties=Excel 8.0;" _ & "Data Source=" & ThisWorkbook.Path & "¥數據表"
           .Open
        End With
        Set rs = New ADODB.Recordset
        Sql = "select * from [Sheet1$]"
        rs.Open Sql, Cnn, adOpenKeyset, adLockOptimistic
        For j = 0 To rs.Fields.Count - 1
           .Cells(1, j + 1) = rs.Fields(j).Name
        Next
        R = .Range("A65536").End(xlUp).Row
        .Range("A" & R + 1).CopyFromRecordset rs
    End With
    rs.Close
    Cnn.Close
    Set rs = Nothing
    Set Cnn = Nothing
End Sub
代碼解析: CopyData_5 過程使建立與“數據表”工作簿的連接,查詢數據記錄后復制到當前工作表中。 第 8 行代碼刪除當前工作表的所有數據。 第 9 行到第 15 行代碼建立與“數據表”工作簿的連接。 第 16 行到第 24 行代碼查詢“數據表”工作簿的全部數據,并復制到工作表中。其中第 20 行代碼將字段名稱(標題行)復制到 工作表中,第 23 行代碼將查詢到的數據記錄復制到工作表。
其它收集的相關內容:  收集的相關內容
示例代碼 1:
Sub testGetValuesFromClosedWorkbook()
   GetValuesFromAClosedWorkbook "C:", "Book1.xls", "Sheet1", "A1:G20"
End Sub

Sub GetValuesFromAClosedWorkbook(fPath As String, fName As String, sName, cellRange As String)
    With ActiveSheet.Range(cellRange)
         .FormulaArray = "='" & fPath & "\[" & fName & "]"  & sName & "'!" & cellRange
          .Value = .Value
     End With
End Sub
本 示 例 包 含 一 個 子 過 程 GetValuesFromAClosedWorkbook , 用 來 從 已 關 關 的 工 作 簿 中 獲 取 數 據 , 主 過 程 testGetValuesFromClosedWorkbook 用來傳遞參數。本示例表示從 C 盤根目錄下的 Book1.xls 工作簿的工作表 Sheet1 中的 A1:G20 單元格區域內獲取數據,并將其復制到當前工作表相應單元格區域中。 示例代碼 2: 已前面的代碼相似,下面的 VBA 代碼從關關的工作簿中獲取值。
Sub ExtractDataFromClosedWorkBook()
    Application.ScreenUpdating = False   '創建鏈接來從關閉的工作簿中獲取數據
   '可以將相關代碼修改為相應的路徑和單元格
   With [Sheet1!A1:B4]
       .Value = "='" & ActiveWorkbook.Path & "\[testDataWorkbook.xls]Sheet1'!A1:B4"  
       '刪除鏈接
      .Value = .Value
     End With
     Application.ScreenUpdating = True
End Sub
其中,可以將代碼中的路徑修改為需要從中獲取值的工作簿的路徑,單元格也作相應的修改。 示例代碼 3:
Sub GetDataFromClosedWorkbook()
    Dim wb As Workbook
    Application.ScreenUpdating = False '以只讀方式打開工作簿
   Set wb = Workbooks.Open("C:\文件夾名\文件.xls", True, True)
   With ThisWorkbook.Worksheets("工作表名")
    '從工作簿中讀取數據
        .Range("A10").Formula = wb.Worksheets("源工作表名").Range("A10").Formula
        .Range("A11").Formula = wb.Worksheets("源工作表名").Range("A20").Formula
        .Range("A12").Formula = wb.Worksheets("源工作表名").Range("A30").Formula
        .Range("A13").Formula = wb.Worksheets("源工作表名").Range("A40").Formula
    End With
    wb.Close False
     '關閉打開的源數據工作簿且不保存任何變化
    Set wb = Nothing '釋放內存
    Application.ScreenUpdating = True
End Sub
在運行程序時,打開所要獲取數據的工作簿,當取得數據后再關關該工作簿。將屏幕更新屬性值設置為 False,將看不出 源數據工作簿是否被打開過。本程序代碼中,“C:\文件夾名\文件.xls”、”源工作表名”代表工作簿所在的文件夾和工作簿 文件名。 示例代碼 4: 下面是 JOHN WALKENBACH 先生使用 VBA 編寫的一個實用函數,其作用是從關關的工作簿中取值。 VBA 沒有包含從關關的文件中獲取值的方法,但是利用 Excel 處理連接文件的功能,可以實現。該函數要調用 XLM 宏,
但不能在工作表公式中使用該函數。 GetValue 函數 具有四個參數,分別如下:
path: 關 關 的文件的驅 動 器和路徑(例如”d:¥files”)
file: 工作簿名稱(例如”99budget.xls”)
sheet: 工作表名稱(例如”Sheet1″)
ref: 單元格引用(例如”C4″)
Private Function GetValue(path, file, sheet, ref)
     ' 從一個關關的工作簿中獲取值
     Dim arg As String ' 確保該文件存在 
     If Right(path, 1) <> "\" Then path = path & "\"
         If Dir(path & file) = "" Then
            GetValue = "File Not Found"
            Exit Function
         End If
         ' 創建參數
         arg = "'" & path & "[" & file & "]" & sheet & "'!" &  Range(ref).Range("A1").Address(, , xlR1C1)
        ' 執行 XLM 宏
        GetValue = ExecuteExcel4Macro(arg)
 End Function
使用 GetValue 函數 要使用該函數,將其復制到 VBA 模塊中,然后使用合適的參數調用該函數。 子過程演示如下,簡單地顯示在名為 99Budget.xls 工作簿 Sheet1 的單元格 A1 中的值,該文件在驅動器 C:中的 XLFiles\Budget 目錄下。
Sub TestGetValue()
      p = "c:\XLFiles\Budget"
      f = "99Budget.xls"
      s = "Sheet1″"
      a = "A1″"
      MsgBox GetValue(p, f, s, a)
End Sub
另一個示例如下,該過程從一個有關
的文件中讀取 1,200 個值(100 行和 12 列),并將這些值放置到活動工作表中。
Sub TestGetValue2()
      p = "c:\XLFiles\Budget"
      f = "99Budget.xls"
      s = "Sheet1″"
     Application.ScreenUpdating = False
     For r = 1 To 100
          For c = 1 To 12
              a = Cells(r, c).Address
              Cells(r, c) = GetValue(p, f, s, a)
         Next c
     Next r
     Application.ScreenUpdating = True
End Sub
注意: 為了使該函數正常運行,在 Excel 中必須有一個活動工作表。如果所有窗口都是隱藏的,或者活動工作表為圖表工作表, 那么將產生錯誤。
示例代碼 5:
Sub ReadDataFromAllWorkbooksInFolder()
     Dim FolderName As String, wbName As String, r As Long, cValue As Variant
     Dim wbList() As String, wbCount As Integer, i As Integer
     FolderName = "C:\文件夾名" '創建文件夾中工作簿列表
     wbCount = 0
     wbName = Dir(FolderName & "\" & "*.xls")
     While wbName <> ""
          wbCount = wbCount + 1
          ReDim Preserve wbList(1 To wbCount)
          wbList(wbCount) = wbName
          wbName = Dir
      Wend
     If wbCount = 0 Then Exit Sub
     '從每個工作簿中獲取數據
     r = 0
     Workbooks.Add
     For i = 1 To wbCount
         r = r + 1
         cValue = GetInfoFromClosedFile(FolderName, wbList(i), "Sheet1", "A1")
         Cells(r, 1).Formula = wbList(i)
         Cells(r, 2).Formula = cValue
     Next i
End Sub

Private Function GetInfoFromClosedFile(ByVal wbPath As String, wbName As String, wsName As String, cellRef As String) As Variant
    Dim arg As String
    GetInfoFromClosedFile = ""
    If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
        If Dir(wbPath & "\" & wbName) = "" Then Exit Function
             arg = "'" & wbPath & "[" & wbName & "]" &  wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
            On Error Resume Next
            GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
本示例將讀取一個文件夾內所有工作簿中工作表 Sheet1 單元格 A1 的值到一個新工作簿中。代碼中,“C:\文件夾名”代 表工作簿所在的文件夾名。
本站僅提供存儲服務,所有內容均由用戶發布,如發現有害或侵權內容,請點擊舉報。
打開APP,閱讀全文并永久保存 查看更多類似文章
猜你喜歡
類似文章
VBA:如何將指定文件夾下所有工作簿的工作表移動到當前工作簿?
Worksheet對象應用大全(2)-應用進階
VBA代碼:拆分工作簿示例——將工作簿中的每個工作表保存為單獨的工作簿
Excel各種密碼解鎖姿勢(收藏備用)
Excel多個工作簿中的工作表合并到一個工作簿中
26,多工作簿提取指定列數據的五種方法
更多類似文章 >>
生活服務
分享 收藏 導長圖 關注 下載文章
綁定賬號成功
后續可登錄賬號暢享VIP特權!
如果VIP功能使用有故障,
可點擊這里聯系客服!

聯系客服

主站蜘蛛池模板: 马关县| 遵义市| 久治县| 阿拉善右旗| 突泉县| 游戏| 布拖县| 大丰市| 界首市| 靖边县| 樟树市| 定日县| 玉环县| 泸溪县| 井陉县| 蒙阴县| 嘉黎县| 大港区| 赣榆县| 平远县| 乐亭县| 屯留县| 舒城县| 象州县| 绥德县| 林芝县| 屏东县| 元江| 靖宇县| 淮北市| 辰溪县| 佛学| 客服| 博乐市| 乌拉特中旗| 河曲县| 行唐县| 乐东| 顺义区| 塘沽区| 岳普湖县|