Question

如何将一个文件夹中多个表格中的固定行列数值提取到一个新的EXCEL表格当中

统计文件用,现在一个文件夹里面很多表格,每个表格都需要提取出不同sheet中的某个单元格的数值,提取出来后要粘贴到一个新的表格中的固定的单元格中..
举例,从工作薄1中提取sheet1中的B7,sheet2中的C5,sheet3中的D6,然后分别粘贴到工作簿2中sheet1的A1,B1,C1
请问上述过程应该如何操作,最好是能打开一个对话框选择打开某某工作簿
能否有个宏可以解决,就是能够调用一个对话框选择要打开的表格,然后自动提取出来想要的单元格中的数据到指定的位置中,因为源表格实在太多,几百个

Answer 1

以Excel2007操作为例：

1、首先打开Excel，如图所示，接着在汇总表中找到需要汇总种类的第一个单元格。

2、然后单击选中的单元格，然后在编辑栏输入“=sum（公司1!”。

3、接着需要汇总的新单元格中，如图所示，此时单元格边框变成虚线状态。

4、然后按住shift键后选中需要汇总的表的最后一张。

5、最后，再返回到刚才编辑框中加上“）”，将公式补全后按回车，这样就可以汇总完成，这样操作就可以解决问题。

Answer 2

将这些文件copy到一个文件夹（只有这些Excel，且若打开某一文件，数据就能看见——即不用点其他sheet），建一新Excel，也存到该文件夹。仅打开该新Excel，按Alt+F11，左边窗口右键点，插入模块，在右边窗口粘贴如下代码：

Sub Find()
Application.ScreenUpdating = False
Dim MyDir As String
MyDir = ThisWorkbook.Path & "\"
ChDrive Left(MyDir, 1) 'find all the excel files
ChDir MyDir
Match = Dir$("")
Do
If Not LCase(Match) = LCase(ThisWorkbook.Name) Then
Workbooks.Open Match, 0 'open
ActiveSheet.Copy Before:=ThisWorkbook.Sheets(1) 'copy sheet
Windows(Match).Activate
ActiveWindow.Close
Match = Dir$
End If
Loop Until Len(Match) = 0
Application.ScreenUpdating = True
End Sub

按F5执行此宏，文件copy完成。

然后可以用sum(sheet12:sheet30!A1)汇总了。
如果数据只有几列的话，可以直接用宏copy到一张工作表中。

Answer 3

Sub CommandButton1_Click()

    Filename = Application.GetOpenFilename(FileFilter:="Excel ,*.xls*", Title:="Choose Files", MultiSelect:=True)

'可使用Ctrl或Shift选择多个文件 
    If Not IsArray(Filename) Then Exit Sub

    Application.ScreenUpdating = False

    For i = 1 To UBound(Filename)

        Set xlbook = Workbooks.Open(Filename(i))

        'sheet1中的B7,sheet2中的C5,sheet3中的D6

        Cells(i, "A") = xlbook.Sheets("sheet1").[B7]

        Cells(i, "B") = xlbook.Sheets("sheet2").[C5]

        Cells(i, "C") = xlbook.Sheets("sheet3").[D6]

        xlbook.Close

    Next i

    Application.ScreenUpdating = True

End Sub

追问

不行呀,我试了几次都不返回数值的

追答

测试没问题。

注意各文件的工作表是否为sheet1、sheet2、sheet3

 

追问

谢谢你
用你这个没问题了!可能是我没有那个按钮的关系,那个按钮是怎么做出来的呀?
如果更改提取数据的单元格位置的话直接在宏里面更改就行了是吧?

追答

按钮就是EXCEL控件工具箱里的。
代码比较简单，看看就应该会改了

Answer 4

使用VBA（宏）代码，按Alt+F11进入VBA界面，按Alt+i+m插入模块后，复制以下代码，按F5执行

Sub copyall()
Dim n%
n=1
For i = 1 To 5 '把这个数字改成你的文件总数
    Set excel_Book = Workbooks.Open("E:\excel\00" & i & ".xlsx") '地址写作"E:\xxx\xxx\"保留英文双引号
    Set excel_Sheet = excel_Book.Worksheets("Natural Hazards")
    excel_Sheet.Range("I7:I17").Copy ThisWorkbook.Worksheets("Sheet1").Cells(1,n)
    n=n+1
    excel_Book.Close False
Next
Set excel_Sheet = Nothing
Set excel_Book = Nothing
End Sub

Answer 5

工作簿2中sheet1的A1,B1,C1分别输入
=[工作簿1.xls]sheet1!B7
=[工作簿1.xls]sheet2!C5
=[工作簿1.xls]sheet3!D6