从多个格式一致的EXCEL中提取单元格位置固定的数据

Question

1.数据来源，模板一致的EXCEL，数据均在sheet1，需要提取数据的单元格也相同。见附图12.结果：导出至汇总表中，见附图23.附图2中的单元格名称为需要在数据表格中提取的excel单元格名称。4.提取后的数据从第二行开始依次往下，第一行为提取项目名称非常感谢！

Answer 1

答：把这些数据源集中在一个文件夹里。然后在汇总表里执行Start程序：

Private Sub Start()

    Dim DesRange As Range

    Dim FilePath As String

    Dim strFileName As String

    Dim Wkb As Workbook

   

    FilePath = GetDirectory

    If FilePath = "" Then Exit Sub

    Set DesRange = Sheets("汇总表").Range("A2")

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    strFileName = Dir(FilePath & "\*.xls*")

    Do Until strFileName = ""

        Set Wkb = GetObject(FilePath & "\" & strFileName)

        With Wkb.Sheets("sheet1")

            DesRange = .Range("B3")

            DesRange.Offset(0, 1) = .Range("D3")

            DesRange.Offset(0, 2) = .Range("F3")

            DesRange.Offset(0, 3) = .Range("D4")

            DesRange.Offset(0, 4) = .Range("F4")

            DesRange.Offset(0, 5) = .Range("B5")

            DesRange.Offset(0, 6) = .Range("B6")

            DesRange.Offset(0, 7) = .Range("B10")

            DesRange.Offset(0, 9) = .Range("B9")

            DesRange.Offset(0, 10) = .Range("E9")

            DesRange.Offset(0, 11) = .Range("B13")

            DesRange.Offset(0, 12) = .Range("B16")

            DesRange.Offset(0, 13) = .Range("B17")

            Set DesRange = DesRange.Offset(1, 0)

            Windows(.Parent.Name).Visible = True

            .Parent.Close SaveChanges:=False

            Set Wkb = Nothing

        End With

        strFileName = Dir

    Loop

    Application.DisplayAlerts = True

    Application.ScreenUpdating = True

    MsgBox "读取完成！"

End Sub

Private Function GetDirectory()

    Dim fd As FileDialog

    Set fd = Application.FileDialog(msoFileDialogFolderPicker)

    With fd

        If .Show = -1 Then

            GetDirectory = .SelectedItems(1)

        Else

            GetDirectory = ""

        End If

    End With

End Function

追问

你好，很感谢你的回答，请问为什么我运行后提示错误呢？

追答

截图的工作表名要设为"汇总表"，运行代码前也要保证该工作表是活动工作表。再试试，我测试过了。

追问

嗯嗯，数据调出来了，还有几个小的地方要麻烦一下你，汇总表中，H列的能调到I列不，另外N列的数据应该是模板中E17呢，能帮忙调整下不，麻烦你了，谢谢

追答

对不起，是我手误
DesRange.Offset(0, 7) = .Range("B10")改为：DesRange.Offset(0, 8) = .Range("B10")
DesRange.Offset(0, 13) = .Range("B17")改为：DesRange.Offset(0, 13) = .Range("E17")

追问

很厉害，很强，我刚已经把这两个改了，完美得到结果，很感谢，方便给我留个联系方式吗？

追答

可以在其他软件加我的号

Answer 2

这个只能用代码来操作哦追问

能不能帮小弟写一段呀，非常感谢

追答

发文件来吧，小弟！

Answer 3

可以用：=left(right(a1,?),11)的形式，？换成从手机号开始向右的字符个数。