VBA一键提取4个excel社保文件的指定单元格

第一步：取得4个文件的路径

Sub toc_2()

    SelectFile ("C2")

End Sub

Sub toc_3()

    SelectFile ("C3")

End Sub

Sub toc_4()

    SelectFile ("C4")

End Sub

Sub toc_5()

    SelectFile ("C5")

End Sub

Sub SelectFile(rng)

    '选择单一文件

    With Application.FileDialog(msoFileDialogFilePicker)

        .InitialFileName = ThisWorkbook.Path

        .AllowMultiSelect = False

        '单选择

        .Filters.Clear

        '清除文件过滤器

        .Filters.Add "Excel Files", "*.xl*"

'        .Filters.Add "All Files", "*.*"

        '设置两个文件过滤器

        If .Show = -1 Then

            'FileDialog 对象的 Show 方法显示对话框，并且返回 -1（如果您按 OK）和 0（如果您按 Cancel）。

             Sheets("设置表").Range(rng) = .SelectedItems(1)

        End If

    End With

End Sub

第二步：取得相关的数据

Sub cle()

        With Sheets("设置表")

        .Range("A10:N10") = ""

        End With

End Sub

Sub ffffffffffffff()

    

    Dim Wb, ws

    Dim arr(13)

    t = Timer()

    With Sheets("设置表")

        .Range("A10:N10") = ""

        If Application.WorksheetFunction.CountA(.Range("c2:c5")) = 4 Then

            sb_file = .Range("c2").Value

            smzx_file = .Range("c3").Value

            smxx_file = .Range("c4").Value

            lcsx_file = .Range("c5").Value

        Else

            MsgBox "有单元格没填写"

            Exit Sub

        End If

    End With

    Application.ScreenUpdating = False

    '''========社保文件==============

    myfile = sb_file '

    Set Wb = GetObject(myfile)

    Set ws = Wb.Worksheets(1)

    With ws

        LastRow = .Cells.Find("*", , , , 1, 2).Row

        getRow = LastRow - 4

        Debug.Print getRow

        arr(1) = .Range("U" & getRow) '社保养老应

        arr(2) = .Range("Z" & getRow) '社保养老补

        arr(3) = .Range("AF" & getRow) '职业年金应

        arr(4) = .Range("AK" & getRow) '职业年金补

    End With

    Wb.Close False

    '''========XXXX中学==============

    myfile = smzx_file

    Set Wb = GetObject(myfile)

    Set ws = Wb.Worksheets(1)

    With ws

        LastRow = .Cells.Find("*", , , , 1, 2).Row

        getRow = LastRow

        Debug.Print getRow

        arr(5) = .Range("a" & getRow - 1) '人数=序号最后一个

        arr(6) = .Range("j" & getRow) '养老单位数据

        arr(7) = .Range("o" & getRow) '职业单位数据

    End With

    Wb.Close False

    '''========XXXX小学==============

    myfile = smxx_file

    Set Wb = GetObject(myfile)

    Set ws = Wb.Worksheets(1)

    With ws

        LastRow = .Cells.Find("*", , , , 1, 2).Row

        getRow = LastRow

        Debug.Print getRow

        arr(8) = .Range("a" & getRow - 1) '人数=序号最后一个a

        arr(9) = .Range("i" & getRow) '养老单位数据=I

        arr(10) = .Range("l" & getRow) '职业单位数据=L

    End With

    Wb.Close False

    '''========XXX小学==============

    myfile = lcsx_file

    Set Wb = GetObject(myfile)

    Set ws = Wb.Worksheets(1)

    With ws

        LastRow = .Cells.Find("*", , , , 1, 2).Row

        getRow = LastRow

        Debug.Print getRow

        arr(11) = .Range("a" & getRow - 1) '人数=序号最后一个

        arr(12) = .Range("h" & getRow) '养老单位数据

        arr(13) = .Range("k" & getRow) '职业单位数据

    End With

    Wb.Close False

    

    With Sheets("设置表")

        For i = 0 To UBound(arr)

            .Cells(10, i + 1) = arr(i)

        Next i

    End With

    

    Application.ScreenUpdating = True

    MsgBox "完成，用时：" & Format(Timer() - t, "00.00秒")

End Sub