怎样通过VB实现多个EXCEL中特定行列的数据的提取

Question

怎样通过VB实现多个EXCEL中特定行列的数据的提取，并且最终放到一个新的excel中，比如说我要吧每个excel中第3行数据提去出来

Answer 1

楼上的都不可使用
我来给个能用的。如果好用 希望楼主多给点分

你在桌面建立个新的excel 命名为 "汇总" (程序运行完可以改名）
并将你的多个excel 放在 D盘根目录下的 “提取”文件夹 ，即创建个文件夹
并命名为“提取”,注意 这些名字都是不带双引号的。

以上步骤做好 然后打开名为 汇总 的excel

依次点击键盘 alt+F11 alt+i m

把以下代码复制进去
Sub 汇总数据()
Application.ScreenUpdating = False
p = "d:\提取\"
f = Dir(p & "*.xls")
Do While f <> ""
Workbooks.Open p & f
r = r + 1

ActiveSheet.Rows(3).Copy

Workbooks("汇总.xls").Sheets("sheet1").Activate
ActiveSheet.Range("A" & r).Select
ActiveSheet.Paste
Application.CutCopyMode = xlCut
Workbooks(f).Activate
ActiveWorkbook.Saved = True
ActiveWindow.Close
f = Dir
Loop
Application.ScreenUpdating = True
End Sub

我这里使用的 excel 2003 如果是你用的2007
把代码中的
Workbooks("汇总.xls").Sheets("sheet1").Activate
改为
Workbooks("汇总.xlsx").Sheets("sheet1").Activate

f = Dir(p & "*.xls")
改为
f = Dir(p & "*.xlsx")

这里是复制的第3行
如过要复制别的行
把代码中的
ActiveSheet.Rows(3).Copy
3 改为你想要的行

然后 敲击 F5 点运行 就ok了

如果还有什么问题可以 百度hi 我 上班时间我都在

Answer 2

在VB中要想调用Excel，需要打开VB编程环境“工程”菜单中的“引用”项目，并选取项目中的“Microsoft Excel 11.0 object library”项。由于你的Excel版本不同，所以这个选项的版本号也是不同的。

因为EXCEL是以层次结构组织对象的，其对象模型中含有许多不同的对象元素。
第一层：Application对象，即Excel本身；
第二层：workbooks对象集，指Excel的工作簿文件；

第三层：worksheets对象集，表示的是Excel的一个工作表；

第四层：Cells和Range对象，指向Excel工作表中的单元格。

新建立一个VB的工程，先放一个button，名称为Excel_Out。先定义好各层：

Dim xlapp As Excel.Application 'Excel对象
Dim xlbook As Excel.Workbook '工作簿
Dim xlsheet As Excel.Worksheet '工作表

我们打算做的是：打开/新建一个excel，在其中对某工作表的一些单元格修改其值，然后另存为test.xls文件。

Private Sub Excel_Out_Click()
Dim i, j As Integer
Set xlapp = CreateObject("Excel.Application") '创建EXCEL对象
'Set xlbook = xlapp.Workbooks.Open(App.Path & "\test.xls") '打开已经存在的test.xls工件簿文件
Set xlbook = xlapp.Workbooks.Add '新建EXCEL工件簿文件
'xlbook.RunAutoMacros (xlAutoOpen) '运行EXCEL启动宏
'xlbook.RunAutoMacros (xlAutoClose) '运行EXCEL关闭宏
xlapp.Visible = True '设置EXCEL对象可见（或不可见）
Set xlsheet = xlbook.Worksheets(1) '设置活动工作表''
''~~~当前工作簿的第一页,这里也可以换成“表名”

'下面就是简单的在一些单元格内写入数字
For i = 7 To 15
For j = 1 To 10

xlsheet.Cells(i, j) = j '当前工作簿第一页的第I行第J列
Next j
Next i

With xlsheet '设置边框为是实线
.Range(.Cells(7, 1), .Cells(28, 29)).Borders.LineStyle = xlContinuous
End With

没有贴完，希望对你有用。

Answer 3

建议：参考书籍，学习VB自动化控制中 如何用VB控制EXCEL ,需要先提取，再输出，实际是不难的。

Answer 4

代码及注释如下：
Sub main()
f = Dir(ThisWorkbook.Path & "\*.xlsx")'搜索本文件下的所有xlsx格式文件(由于一般带VBA的文件不能保存为xlsx格式，故无需去判断，是否打开的是本文件）
Do While f <> ""
Workbooks.Open (ThisWorkbook.Path & "\" & f)'依次打开搜索到的文件
Workbooks(f).Sheets(1).Row(3).Copy Sheets(1).Range("A" & Range("A65536").End(3).Row + 1)'将打开的文件第3行复制到本文件最后一个非空行的下一行中
Workbooks(f).Close'关闭文件
f = Dir'赋值下一个文件名给f
Loop'继续循环
End Sub