Vba读取已关闭的Excel工作薄数据.docx
《Vba读取已关闭的Excel工作薄数据.docx》由会员分享，可在线阅读，更多相关《Vba读取已关闭的Excel工作薄数据.docx（11页珍藏版）》请在冰豆网上搜索。
Vba读取已关闭的Excel工作薄数据
使用Vba读取已关闭的Excel工作薄数据到当前工作表单元格之简单范例
范例环境：
在F:
\盘根目录下，存在一工作薄，名称为“成绩表.xls”，其对应的路径是：
“F:
\成绩表.xls”；
该工作薄第一个工作表名称是：
Sheet1，里面存放的是学生期末考试成绩，其中，E列从E3开始，就是学生的考试成绩；
下面我们要实现的是，在关闭F:
\成绩表.xls情况下，打开Excel软件，新建一工作薄，在其工作表中的指定单元格，读取F:
\成绩表.xls中的指定的成绩数据进行填充；
①：
在新建的工作表中直接按下组合键：
Alt+F11，打开MicrosoftVisualBasic窗口；如果打开的窗口没有出现代码窗口，那么，请在当前窗口执行操作：
“视图”→“代码窗口”；
②：
在代码窗口中输入如下的代码：
PrivateFunctionGetValue（path,filename,sheet,ref）
'从关闭的工作薄返回值
DimMyPathAsString
'确定文件是否存在
IfRight（path,1）<>"\"Thenpath=path&"\"
IfDir（path&filename）=""Then
GetValue="无法找到指定的Excel文件"
ExitFunction
EndIf
'创建公式
MyPath="'"&path&"["&filename&"]"&sheet&"'!
"&Range（ref）.Range（"A1"）.Address（,,xlR1C1）
'执行EXCEL4宏函数
GetValue=Application._executeExcel4Macro（MyPath）
EndFunction
'函数参数说明
'-----------------------------------------------------------------
'path：
文件路径
'filename：
文件名称
'sheet：
工作表名称
'ref：
单元格区域
'-----------------------------------------------------------------
SubGetCloseXlsValue（）
Range（"C3"）.Value=GetValue（"F:
\","成绩表.xls","Sheet1","E8"）
EndSub
如下图：
上述代码的功能是：
读取F:
\成绩表.xls中E8单元格的数据填充到当前EXCEL的C3单元格中；
上述代码的诠释已做说明，不再阐述！
之后直接按下F5运行代码，或点击代码运行按钮执行代码的操作，返回EXCEL窗口，即可看到填充效果；
知识扩展：
如何对关闭的工作薄数据进行求和再填充到当前工作表？
可将Range（"C3"）.Value=GetValue（"F:
\","成绩表.xls","Sheet1","E8"）
改为：
Range（"C3"）.Value=GetValue（"F:
\","成绩表.xls","Sheet1","E8"）+GetValue（"F:
\","成绩表.xls","Sheet1","E9"）+GetValue（"F:
\","成绩表.xls","Sheet1","E10"）
这样，对E8,E9,E10三个单元格进行相加求和之后，再填充过来；
如果想填充其他单元格数据到当前工作表的其他单元格，只需要修改来处即可：
①：
Range（"C3"）.Value，修改C3
②：
GetValue（"F:
\","成绩表.xls","Sheet1","E8"），修改盘符，文件名，工作表名，E8单元格
如果想使用更智能的办法，必须使用循环语句来控制，本例暂且不作介绍；
Excel不打开工作薄读取数据另一示例程序设计相关2009-04-2408:
46:
41阅读100评论0字号：
大中小
PrivateSubCommandButton1_Click（）'导入其他料单统计表数据
OnErrorResumeNext
aa="要从第"&asrd&"行开始导入数据吗?
"&vbLf&vbLf
aa=aa&"本操作的过程如下:
"&vbLf
aa=aa&"第1步导入用料数据;"&vbLf
aa=aa&"第2步导入定位符数据;"&vbLf
aa=aa&"第3步导入材料数据."&vbLf
v=MsgBox（aa,65,"导入数据"）
Ifv=1Then
filetoopen=Application.GetOpenFilename（"Excel97～2003（*.xls）,*.xls,Excel2007（*.xlsx）,*.xlsx",,"选择要导入数据的料单统计表"）'得到导入数据文件路径
Iffiletoopen=ActiveWorkbook.FullNameThen'如果导入自身就停止导入操作
v=MsgBox（"不能导入自身数据",64,"文件选择错误"）
ExitSub
EndIf
Iffiletoopen=FalseThen'如果没有选择文件就停止导入操作
v=MsgBox（"没有选择文件,终止本次数据导入操作",64,"文件选择错误"）
ExitSub
EndIf
i=Len（filetoopen）'得到导入数据文件名
WhileMid（filetoopen,i,1）<>"\"
IfMid（filetoopen,i,1）=""Then
v=MsgBox（"文件名不能包含空格",64,"文件名错误"）'文件名包含空格就退出
ExitSub
EndIf
i=i-1
Wend
wenjianming=Right（filetoopen,Len（filetoopen）-i）
va1=0'导入的用料数据行数
va2=0'导入的定位符个数
va3=0'导入的材料个数
n1=0'空行记录
n2=0'是否记录空行数
n=2'导入数据表的操作行数
k1=asrd'导入数据开始放入的行数
k2=asrd+1
v=MsgBox（"1、导入用料数据",36,"数据导入操作开始"）
Ifv=7ThenGoTort_1
Worksheets（"用料录入"）.Cells（asrd,2）.Formula="=["&wenjianming&"]用料录入!
R"&n&"C"&1
WhileWorksheets（"用料录入"）.Cells（asrd,2）.Value<>"begin"
IfWorksheets（"用料录入"）.Cells（asrd,2）.Value="over"ThenExitSub
Fori=1To6
Worksheets（"用料录入"）.Cells（k1+n-1,i）.Value=""
Next
n=n+1
Ifn>50Then
a1="数据源数据有误，是否继续执行下一步导入操作?
"&vbLf&vbLf
a1=a1&"'是'继续导入操作."&vbLf
a1=a1&"'否'终止导入操作."&vbLf
v=MsgBox（a1,36,"数据导入中……"）
GoTort_1
ExitSub
EndIf
Worksheets（"用料录入"）.Cells（asrd,2）.Formula="=["&wenjianming&"]用料录入!
R"&n&"C"&1
Wend
k1=k1+n-1
k2=k2+n-1
n=n+1
Worksheets（"用料录入"）.Cells（asrd,2）.Formula="=["&wenjianming&"]用料录入!
R"&n&"C"&1
WhileWorksheets（"用料录入"）.Cells（asrd,2）.Value<>"over"'开始导入材料用量数据
IfWorksheets（"用料录入"）.Cells（asrd,2）.Value<>0AndWorksheets（"用料录入"）.Cells（asrd,2）.Value<>"begin"Then
Fori=1To6
Worksheets（"用料录入"）.Cells（k1,i）.Formula="=["&wenjianming&"]用料录入!
R"&n&"C"&i
Worksheets（"用料录入"）.Cells（k1,i）.Value=Worksheets（"用料录入"）.Cells（k1,i）.Value
IfWorksheets（"用料录入"）.Cells（k1,i）.Value=0ThenWorksheets（"用料录入"）.Cells（k1,i）.Value=""
Next
va1=va1+1
Else
Fori=2To6
Worksheets（"用料录入"）.Cells（k1,i）.Formula="=["&wenjianming&"]用料录入!
R"&n&"C"&i
Worksheets（"用料录入"）.Cells（k1,i）.Value=Worksheets（"用料录入"）.Cells（k1,i）.Value
IfWorksheets（"用料录入"）.Cells（k1,i）.Value=0ThenWorksheets（"用料录入"）.Cells（k1,i）.Value=""
Next
EndIf
Fori=2To6
Worksheets（"用料录入"）.Cells（k2,i）.Value=""
Next
Ifn1=40Then
a1="有大量空行数据，是否继续执行导入操作?
"&vbLf&vbLf
a1=a1&"'是'继续导入数据."&vbLf
a1=a1&"'否'终止导入数据."&vbLf
a1=a1&"'取消'继续导入数据,不再提示."
v=MsgBox（a1,35,"数据导入中……"）
Ifv=7ThenGoTow10
Ifv=2Thenn2=1
n1=0
EndIf
IfWorksheets（"用料录入"）.Cells（asrd,2）.Value=0Andn2=0Thenn1=n1+1
k1=k1+1
k2=k2+1
n=n+1
Worksheets（"用料录入"）.Cells（asrd,2）.Formula="=["&wenjianming&"]用料录入!
R"&n&"C"&1
Wend
w10:
Worksheets（"用料录入"）.Cells（k2,1）.Value="over"
'导入定位符
rt_1:
v=MsgBox（"2、用料数据导入完毕,是否继续导入定位符?
",36,"数据导入中……"）
Worksheets（"用料录入"）.Cells（asrd,2）.Value=""
Ifv=6Then
n=2'本表的定位符位置
WhileWorksheets（"统计分析"）.Cells（n,18）.Value<>""
n=n+1
Wend
n1=2
n2=n1+n-2
Worksheets（"用料录入"）.Cells（asrd,2）.Formula="=["&wenjianming&"]统计分析!
R"&n1&"C"&18
Worksheets（"用料录入"）.Cells（asrd,2）.Value=Worksheets（"用料录入"）.Cells（asrd,2）.Value
IfWorksheets（"用料录入"）.Cells（asrd,2）.Value=0ThenWorksheets（"用料录入"）.Cells（asrd,2）.Value=""
WhileWorksheets（"用料录入"）.Cells（asrd,2）.Value<>""AndWorksheets（"用料录入"）.Cells（asrd,2）.Value<>0
Worksheets（"统计分析"）.Cells（n2,16）.Formula="=["&wenjianming&"]统计分析!
R"&n1&"C"&16
Worksheets（"统计分析"）.Cells（n2,16）.Value=Worksheets（"统计分析"）.Cells（n2,16）.Value
Worksheets（"统计分析"）.Cells（n2,17）.Formula="=["&wenjianming&"]统计分析!
R"&n1&"C"&17
Worksheets（"统计分析"）.Cells（n2,17）.Value=Worksheets（"统计分析"）.Cells（n2,17）.Value+asrd-2
Worksheets（"统计分析"）.Cells（n2,18）.Formula="=["&wenjianming&"]统计分析!
R"&n1&"C"&18
Worksheets（"统计分析"）.Cells（n2,18）.Value=Worksheets（"统计分析"）.Cells（n2,18）.Value
IfWorksheets（"用料录入"）.Cells（Worksheets（"统计分析"）.Cells（n2,17）.Value,Worksheets（"统计分析"）.Cells（n2,16）.Value）.Value=""Then_
Worksheets（"用料录入"）.Cells（Worksheets（"统计分析"）.Cells（n2,17）.Value,Worksheets（"统计分析"）.Cells（n2,16）.Value）.Value=_
Worksheets（"统计分析"）.Cells（n2,18）.Value
va2=va2+1
n1=n1+1
n2=n1+n-2
Worksheets（"用料录入"）.Cells（asrd,2）.Formula="=["&wenjianming&"]统计分析!
R"&n1&"C"&18
Worksheets（"用料录入"）.Cells（asrd,2）.Value=Worksheets（"用料录入"）.Cells（asrd,2）.Value
Wend
Calldingwei
EndIf
'导入本表中没有的材料
v=MsgBox（"3、定位符数据导入完毕,是否继续导入材料库数据?
",36,"数据导入中……"）
Ifv=6Then
Callcailiao
ax=1'判定是否有不同的材料
n=2'本表的定位符位置
ak=0'判断是否有多个余量系数0没有1有
Worksheets（"用料录入"）.Cells（asrd,2）.Formula="=["&wenjianming&"]材料管理!
R"&1&"C"&4
Worksheets（"用料录入"）.Cells（asrd,2）.Value=Worksheets（"用料录入"）.Cells（asrd,2）.Value
IfWorksheets（"用料录入"）.Cells（asrd,2）.Value="余量系数1"Thenak=1'判断导入材料的版本
Worksheets（"用料录入"）.Cells（asrd,2）.Formula="=["&wenjianming&"]材料管理!
R"&n&"C"&1
Worksheets（"用料录入"）.Cells（asrd,2）.Value=Worksheets（"用料录入"）.Cells（asrd,2）.Value
IfWorksheets（"用料录入"）.Cells（asrd,2）.Value=0ThenWorksheets（"用料录入"）.Cells（asrd,2）.Value=""
WhileWorksheets（"用料录入"）.Cells（asrd,2）.Value<>""
Fori=1Toclgeshu
IfWorksheets（"用料录入"）.Cells（asrd,2）.Value=cllist（i）.clnameThen
ax=0
ExitFor
Else
ax=n
EndIf
Next
Ifax<>0Then'导入的材料进行名称排列
axx=yhclgeshu+2
acd1=Left（Worksheets（"用料录入"）.Cells（asrd,2）.Value,2）'得到添加材料名称的前两个字符
Fori=1Toclgeshu
acd2=Left（Worksheets（"材料管理"）.Cells（i+1,1）.Value,2）'得到材料管理中材料名称的前两个字符
Ifacd1=acd2Then
Worksheets（"材料管理"）.Rows（i+1）.InsertShift:
=xlDown
axx=i+1'插入材料的位置
ExitFor
EndIf
Next
clgeshu=clgeshu+1
yhclgeshu=yhclgeshu+1
va3=va3+1
Worksheets（"材料管理"）.Cells（axx,1）.Value=Worksheets（"用料录入"）.Cells（asrd,2）.Value
Worksheets（"材料管理"）.Cells（axx,2）.Formula="=["&wenjianming&"]材料管理!
R"&ax&"C"&2
Worksheets（"材料管理"）.Cells（axx,2）.Value=Worksheets（"材料管理"）.Cells（axx,2）.Value
Worksheets（"材料管理"）.Cells（axx,3）.Formula="=["&wenjianming&"]材料管理!
R"&ax&"C"&3
Worksheets（"材料管理"）.Cells（axx,3）.Value=Worksheets（"材料管理"）.Cells（axx,3）.Value
Ifak=0Then'导入2.3以前版本材料
Worksheets（"材料管理"）.Cells（axx,4）.Formula="=["&wenjianming&"]材料管理!
R"&ax&"C"&4
Worksheets（"材料管理"）.Cells（axx,4）.Value=Worksheets（"材料管理"）.Cells（axx,4）.Value
Worksheets（"材料管理"）.Cells（axx,5）.Value=1
Worksheets（"材料管理"）.Cells（axx,6）.Value=1
Worksheets（"材料管理"）.Cells（axx,7）.Formula="=["&wenjianming&"]材料管理!
R"&ax&"C"&5
Worksheets（"材料管理"）.Cells（axx,7）.Value=Worksheets（"材料管理"）.Cells（axx,7）.Value
Worksheets（"材料管理"）.Cells（axx,8）.Formula="=["&wenjianming&"]材料管理!
R"&ax&"C"&6
Worksheets（"材料管理"）.Cells（axx,8）.Value=Worksheets（"材料管理"）.Cells（axx,8）.Value
IfWorksheets（"材料管理"）.Cells（axx,8）.Value=0ThenWorksheets（"材料管理"）.Cells（axx,8）.Value=""
Else'导入2.3以后版本材料
Worksheets（"材料管理"）.Cells（axx,4）.Formula="=["&wenjianming&"]材料管理!
R"&ax&"C"&4
Worksheets（"材料管理"）.Cells（axx,4）.Value=Worksheets（"材料管理"）.Cells（axx,4）.Value
Worksheets（"材料管理"）.Cells（axx,5）.Formula="=["&wenjianming&"]材料管理!
R"&ax&"C"&5
Worksheets（"材料管理"）.Cells（axx,5）.Value=Worksheets（"材料管理"）.Cells（axx,5）.Value
Worksheets（"材料管理"）.Cells（axx,6）.Formula="=["&wenjianming&"]材料管理!
R"&ax&"C"&6
Worksheets（"材料管理"）.Cells（axx,6）.Value=Worksheets（"材料管
升级会员 