vba从关闭问卷中提取数值

Sub testGetValuesFromClosedWorkbook() GetValuesFromAClosedWorkbook \"C:\", \"Book1.xls\", \"Sheet1\", \"A1:G20\" EndSub

Sub GetValuesFromAClosedWorkbook(fPath AsString, _ fName AsString, sName, cellRange AsString) With ActiveSheet.Range(cellRange)

.FormulaArray = \"='\"& fPath &\"\\[\"& fName &\"]\" _ & sName &\"'!\"& cellRange .Value = .Value EndWith EndSub

本示例包含一个子过程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 EndWith

Application.ScreenUpdating = True

EndSub

其中，可以将代码中的路径修改为需要从中获取值的工作簿的路径，单元格也作相应的修改。 示例代码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 EndWith

wb.CloseFalse'关闭打开的源数据工作簿且不保存任何变化 Set wb = Nothing'释放内存

Application.ScreenUpdating = True EndSub

在运行程序时，打开所要获取数据的工作簿，当取得数据后再关闭该工作簿。将屏幕更新属性值设置为False，将看不出源数据工作簿是否被打开过。本程序代码中，“C:\\文件夹名\\文件.xls”、”源工作表名”代表工作簿所在的文件夹和工作簿文件名。 示例代码4： 下面是JOHN WALKENBACH先生使用VBA编写的一个实用函数，其作用是从关闭的工作簿中取值。

VBA没有包含从关闭的文件中获取值的方法，但是利用Excel处理连接文件的功能，可以实现。该函数要调用XLM宏，但不能在工作表公式中使用该函数。

GetValue函数

具有四个参数，分别如下：

path: 关闭的文件的驱动器和路径(例如”d:\\files”)  file: 工作簿名称(例如”99budget.xls”)  sheet: 工作表名称(例如”Sheet1″)  ref: 单元格引用(例如”C4″)



PrivateFunction GetValue(path, file, sheet, ref) ' 从一个关闭的工作簿中获取值 Dim arg AsString' 确保该文件存在

If Right(path, 1) <>\"\\\"Then path = path &\"\\\" If Dir(path & file) = \"\"Then

GetValue = \"File Not Found\" ExitFunction EndIf ' 创建参数

arg = \"'\"& path &\"[\"& file &\"]\"& sheet &\"'!\"& _ Range(ref).Range(\"A1\").Address(, , xlR1C1) ' 执行XLM宏

GetValue = ExecuteExcel4Macro(arg) EndFunction

使用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) EndSub

另一个示例如下，该过程从一个关闭的文件中读取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 EndSub

注意：

为了使该函数正常运行，在Excel中必须有一个活动工作表。如果所有窗口都是隐藏的，或者活动工作表为图表工作表，那么将产生错误。 示例代码5：

Sub ReadDataFromAllWorkbooksInFolder()

Dim FolderName AsString, wbName AsString, r AsLong, cValue AsVariant

Dim wbList() AsString, wbCount AsInteger, i AsInteger FolderName = \"C:\\文件夹名\" '创建文件夹中工作簿列表

wbCount = 0

wbName = Dir(FolderName &\"\\\"&\"*.xls\") While wbName <>\"\"

wbCount = wbCount + 1

ReDimPreserve wbList(1 To wbCount) wbList(wbCount) = wbName wbName = Dir Wend

If wbCount = 0 ThenExitSub '从每个工作簿中获取数据

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

EndSub

PrivateFunction GetInfoFromClosedFile(ByVal wbPath AsString, _

wbName AsString, wsName AsString, cellRef AsString) AsVariant

Dim arg AsString

GetInfoFromClosedFile = \"\"

If Right(wbPath, 1) <>\"\\\"Then wbPath = wbPath &\"\\\" If Dir(wbPath &\"\\\"& wbName) = \"\"ThenExitFunction arg = \"'\"& wbPath &\"[\"& wbName &\"]\"& _

wsName &\"'!\"& Range(cellRef).Address(True, True, xlR1C1)

OnErrorResumeNext

GetInfoFromClosedFile = ExecuteExcel4Macro(arg) EndFunction