Question

如何从一个文件夹多个excel里面的固定位置单元格提取数据！

有一个名为“国税”的文件夹，里面有很多格式相同的电子表格，每个电子表格是一个人的详细信息，电子表格的文件名是每个人的姓名。我想新建一个汇总表，把所有电子表格某一部分的信息，全部提取到汇总表中。比如我要把每个党员信息采集表中的姓名、性别、身份证号码都提取到这个汇总表中。





Answer 1

具体操作步骤如下：

1、首先，在桌面上找到并打开Excel表格。如下图所示，然后进入下一步。

2、其次，在excel页面顶部菜单栏中，点击方方格子，然后选择工作表-汇总拆分。如下图所示，然后进入下一步。

3、接着，完成上述步骤后，选择“汇总大师”选项。如下图所示，然后进入下一步。

4、然后，在弹出页面中，单击左侧选项栏中的“多薄提取到一表”选项。如下图所示，然后进入下一步。

5、随后，在弹出窗口中，单击“开始”按钮。如下图所示，然后进入下一步。

6、接着，在弹出窗口中，单击“添加文件”按钮。如下图所示，然后进入下一步。

7、然后，选择多个Excel文件以提取指定的单元格数据。如下图所示，然后进入下一步。

8、选好后，单击下面的“打开”按钮。如下图所示，然后进入下一步。

9、接着，在弹出窗口中，选择“区域”和“提取数值”以提取指定的单元格数据。如下图所示，然后进入下一步。

10、然后，完成上述步骤后，单击“开始”。如下图所示，然后进入下一步。

11、随后，完成上述步骤后，提示提取成功，单击“确定”即可。如下图所示，然后进入下一步。

12、最后，在此界面中，可以看到指定的单元格数据已成功从多个Excel文件中提取。如下图所示。

Answer 2

我的理解：所有人的信息都在一个名为"国税"的文件（也就是工作簿）内，包含很多工作表，每个工作表标签就是每个人的名字，希望在这个工作簿内创建一个汇总表，并按照你给的格式（也就是单项要填写的位置）提取各个工作表的指定位置内容到汇总表的指定列，是不是这样？如果是这样，可用公式解决，等你确认后再往下走。

追问

不是的，是国税文件夹，不是工作簿

Answer 3

此代码只提取一个单元格内容,

Sub 批量提取字符()
Dim myFile, lj, r, c, n
r = 2 '指定提取单元格行
c = 2 '指定提取单元格列
n = 0 
book1 = ActiveWorkbook.Name
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)
If objFolder Is Nothing Then
    MsgBox "未选择文件夹"
    Exit Sub
End If
lj = objFolder.self.Path
If Right(lj, 1) <> "\" Then
    lj = lj & "\"
End If
Set objFolder = Nothing
Set objShell = Nothing
myFile = Dir(lj & "*.xls")
While myFile <> ""
    Workbooks.Open lj & myFile
    n = n + 1
    Workbooks(book1).Sheets(1).Cells(n, 1).Value = ActiveWorkbook.Sheets("信息表").Cells(r, c).Value  '提取指定单元格字符,欲提取多个自行增加代码
    ActiveWorkbook.Close 1
    myFile = Dir
Wend
End Sub

追问

不能提取多个吗？

追答

可以啊，不是备注自己按格式新增代码吗

追问

你这个我弄上去就崩溃了。文件夹名字是“国税”，里面的电子表格名称就是每个人的姓名。你给我写个一次提取姓名、性别、身份证号码的提取代码吧！谢谢了！

追答

Sub 批量提取字符()
    Dim myFile, lj, n
    n = 0
    book1 = ActiveWorkbook.Name
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)
    If objFolder Is Nothing Then
        MsgBox "未选择文件夹"
        Exit Sub
    End If
    lj = objFolder.self.Path
    If Right(lj, 1) <> "\" Then
        lj = lj & "\"
    End If
    Set objFolder = Nothing
    Set objShell = Nothing
    myFile = Dir(lj & "*.xls")
    While myFile <> ""
        Workbooks.Open lj & myFile
        n = n + 1
        With ActiveWorkbook.ActiveSheet
            Workbooks(book1).Sheets(1).Cells(n, 1).Value = .Cells(3, 2).Value
            Workbooks(book1).Sheets(1).Cells(n, 2).Value = .Cells(3, 4).Value
            Workbooks(book1).Sheets(1).Cells(n, 3).Value = .Cells(9, 6).Value
        End With
        ActiveWorkbook.Close 1
        myFile = Dir
    Wend
End Sub

Answer 4

VBA实现，请把这个表发到我邮箱里以及另外一个要汇总的总表发过来，做好后，我整体打包发给你。
邮箱号：gjh_3686350@163.com

追问

我就是想学学怎么做代码，你直接给我代码吧