Vba读取已关闭的Excel工作薄数据.doc

使用Vba读取已关闭的Excel工作薄数据到当前工作表单元格之简单范例范例环境：在F:盘根目录下，存在一工作薄，名称为“成绩表.xls”，其对应的路径是：“F:成绩表.xls”；该工作薄第一个工作表名称是：Sheet1，里面存放的是学生期末考试成绩，其中，E列从E3开始，就是学生的考试成绩；下面我们要实现的是，在关闭F:成绩表.xls情况下，打开Excel软件，新建一工作薄，在其工作表中的指定单元格，读取F:成绩表.xls中的指定的成绩数据进行填充；：在新建的工作表中直接按下组合键：Alt+F11，打开Microsoft Visual Basic窗口；如果打开的窗口没有出现代码窗口，那么，请在当前窗口执行操作：“视图”“代码窗口”；：在代码窗口中输入如下的代码：Private Function GetValue(path, filename, sheet, ref) 从关闭的工作薄返回值 Dim MyPath As String 确定文件是否存在 If Right(path, 1) Then path = path & If Dir(path & filename) = Then GetValue = 无法找到指定的Excel文件 Exit Function End If 创建公式 MyPath = & path & & filename & & sheet & ! & Range(ref).Range(A1).Address(, , xlR1C1) 执行EXCEL4宏函数 GetValue = Application._executeExcel4Macro(MyPath)End Function函数参数说明-path：文件路径filename：文件名称sheet：工作表名称ref： 单元格区域-Sub GetCloseXlsValue() Range(C3).Value = GetValue(F:, 成绩表.xls, Sheet1, E8)End Sub如下图：上述代码的功能是：读取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-24 08:46:41 阅读100 评论0 字号：大中小 Private Sub CommandButton1_Click() 导入其他料单统计表数据 On Error Resume Next aa = 要从第 & asrd & 行开始导入数据吗? & vbLf & vbLf aa = aa & 本操作的过程如下: & vbLf aa = aa & 第1步 导入 用料数据; & vbLf aa = aa & 第2步 导入 定位符数据; & vbLf aa = aa & 第3步 导入 材料数据. & vbLf v = MsgBox(aa, 65, 导入数据) If v = 1 Then filetoopen = Application.GetOpenFilename(Excel972003 (*.xls), *.xls,Excel2007 (*.xlsx), *.xlsx, , 选择要导入数据的料单统计表) 得到导入数据文件路径 If filetoopen = ActiveWorkbook.FullName Then 如果导入自身就停止导入操作 v = MsgBox(不能导入自身数据, 64, 文件选择错误) Exit Sub End If If filetoopen = False Then 如果没有选择文件就停止导入操作 v = MsgBox(没有选择文件,终止本次数据导入操作, 64, 文件选择错误) Exit Sub End If i = Len(filetoopen) 得到导入数据文件名 While Mid(filetoopen, i, 1) If Mid(filetoopen, i, 1) = Then v = MsgBox(文件名不能包含空格, 64, 文件名错误) 文件名包含空格就退出 Exit Sub End If 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, 数据导入操作开始) If v = 7 Then GoTo rt_1 Worksheets(用料录入).Cells(asrd, 2).Formula = = & wenjianming & 用料录入!R & n & C & 1 While Worksheets(用料录入).Cells(asrd, 2).Value begin If Worksheets(用料录入).Cells(asrd, 2).Value = over Then Exit Sub For i = 1 To 6 Worksheets(用料录入).Cells(k1 + n - 1, i).Value = Next n = n + 1 If n 50 Then a1 = 数据源数据有误，是否继续执行下一步导入操作? & vbLf & vbLf a1 = a1 & 是 继续导入操作. & vbLf a1 = a1 & 否 终止导入操作. & vbLf v = MsgBox(a1, 36, 数据导入中) GoTo rt_1 Exit Sub End If 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 While Worksheets(用料录入).Cells(asrd, 2).Value over 开始导入材料用量数据 If Worksheets(用料录入).Cells(asrd, 2).Value 0 And Worksheets(用料录入).Cells(asrd, 2).Value begin Then For i = 1 To 6 Worksheets(用料录入).Cells(k1, i).Formula = = & wenjianming & 用料录入!R & n & C & i Worksheets(用料录入).Cells(k1, i).Value = Worksheets(用料录入).Cells(k1, i).Value If Worksheets(用料录入).Cells(k1, i).Value = 0 Then Worksheets(用料录入).Cells(k1, i).Value = Next va1 = va1 + 1 Else For i = 2 To 6 Worksheets(用料录入).Cells(k1, i).Formula = = & wenjianming & 用料录入!R & n & C & i Worksheets(用料录入).Cells(k1, i).Value = Worksheets(用料录入).Cells(k1, i).Value If Worksheets(用料录入).Cells(k1, i).Value = 0 Then Worksheets(用料录入).Cells(k1, i).Value = Next End If For i = 2 To 6 Worksheets(用料录入).Cells(k2, i).Value = Next If n1 = 40 Then a1 = 有大量空行数据，是否继续执行导入操作? & vbLf & vbLf a1 = a1 & 是 继续导入数据. & vbLf a1 = a1 & 否 终止导入数据. & vbLf a1 = a1 & 取消 继续导入数据,不再提示. v = MsgBox(a1, 35, 数据导入中) If v = 7 Then GoTo w10 If v = 2 Then n2 = 1 n1 = 0 End If If Worksheets(用料录入).Cells(asrd, 2).Value = 0 And n2 = 0 Then n1 = 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 = If v = 6 Then n = 2 本表的定位符位置 While Worksheets(统计分析).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 If Worksheets(用料录入).Cells(asrd, 2).Value = 0 Then Worksheets(用料录入).Cells(asrd, 2).Value = While Worksheets(用料录入).Cells(asrd, 2).Value And Worksheets(用料录入).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 If Worksheets(用料录入).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 Call dingwei End If 导入本表中没有的材料 v = MsgBox(3、定位符数据导入完毕,是否继续导入材料库数据?, 36, 数据导入中) If v = 6 Then Call cailiao 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 If Worksheets(用料录入).Cells(asrd, 2).Value = 余量系数1 Then ak = 1 判断导入材料的版本 Worksheets(用料录入).Cells(asrd, 2).Formula = = & wenjianming & 材料管理!R & n & C & 1 Worksheets(用料录入).Cells(asrd, 2).Value = Worksheets(用料录入).Cells(asrd, 2).Value If Worksheets(用料录入).Cells(asrd, 2).Value = 0 Then Worksheets(用料录入).Cells(asrd, 2).Value = While Worksheets(用料录入).Cells(asrd, 2).Value For i = 1 To clgeshu If Worksheets(用料录入).Cells(asrd, 2).Value = cllist(i).clname Then ax = 0 Exit For Else ax = n End If Next If ax 0 Then 导入的材料进行名称排列 axx = yhclgeshu + 2 acd1 = Left(Worksheets(用料录入).Cells(asrd, 2).Value, 2) 得到添加材料名称的前两个字符 For i = 1 To clgeshu acd2 = Left(Worksheets(材料管理).Cells(i + 1, 1).Value, 2) 得到材料管理中材料名称的前两个字符 If acd1 = acd2 Then Worksheets(材料管理).Rows(i + 1).Insert Shift:=xlDown axx = i + 1 插入材料的位置 Exit For End If 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 If ak = 0 Then 导入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 If Worksheets(材料管理).Cells(axx, 8).Value = 0 Then Worksheets(材料管理).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(材料管理).Cells(axx, 6