ExcelVBA每个月取得人员信息备份在一个文件中

哆哆Excel

发布于 2022-10-25 05:47:32

40400

代码可运行

文章被收录于专栏：哆哆Excel哆哆Excel

运行总次数：0

代码可运行

代码用于自己保存与学习之用

'取得包括全路径的文件名，并根据“农行”两字判别是那一种文件赋值相关的信息

Sub getFileMain()
    Dim fd As FileDialog, MyOb As Object
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vSelItem As Variant
    row_n = 1
    With fd
        .InitialFileName = ThisWorkbook.Path
        If .Show = -1 Then
            For Each vSelItem In .SelectedItems
            row_n = row_n + 1
           Sheets("main").Cells(row_n, 1) = vSelItem
           If InStr(1, vSelItem, "农行") > 0 Then
           Sheets("main").Cells(row_n, 2) = "编外工资"
           Sheets("main").Cells(row_n, 3) = "金额合计"
           Sheets("main").Cells(row_n, 4) = "1,2,3,4,6,7"
           Else
           Sheets("main").Cells(row_n, 2) = "在职明细"
           Sheets("main").Cells(row_n, 3) = "合计"
           Sheets("main").Cells(row_n, 4) = "1,2,3,4,29,30"
           End If
            Next vSelItem
        Else
        MsgBox "没有选择文件"
        Exit Sub
        End If
    End With
    Set fd = Nothing
End Sub

'取得区工资+编外工资表中的人员信息可用于公积金与个人所得税的用途 '知识点：（１）字典并给item赋值数组的方法，（2）GetObject打开文件（3）Sheets.Add新建工作表（4）Split,Replace，Mid,InStr,Find方法(5)Redim数组

Sub get人员信息()
    Dim dic As Object, mainsht As Worksheet, myobj As Object, addsht As Worksheet
    Dim title_arr, temp_arr, main_arr, col_arr
    Dim end_row, start_n, shtnameStr
    Set dic = CreateObject("scripting.dictionary")
    title_arr = Array("序号", "单位", "姓名", "身份证", "岗位", "职务", "工作表")
    With Sheets("main")
        main_arr = .Range("a1").CurrentRegion
    End With
    total_num = 1
    For i = 2 To UBound(main_arr, 1)
        col_arr = Split(Replace(main_arr(i, 4), "，", ","), ",")
        ReDim temp_arr(1 To UBound(col_arr) + 2)
        'MsgBox UBound(col_arr)
        Set myobj = GetObject(main_arr(i, 1))
        With myobj
            With myobj.Worksheets(main_arr(i, 2))
                end_row = .Cells.Find(main_arr(i, 3), , , , 1, 2).Row - 1
                For rowj = 5 To end_row
                    If .Cells(rowj, 1) <> "" Then
                        For colj = 1 To UBound(temp_arr) - 1
                            temp_arr(colj) = .Cells(rowj, Val(col_arr(colj - 1)))
                        Next colj
                        If colj = UBound(temp_arr) And InStr(1, main_arr(i, 1), "农行") > 0 Then
                            temp_arr(UBound(temp_arr)) = "编外工资表"
                            shtnameStr = Mid(main_arr(i, 1), InStr(1, main_arr(i, 1), "农行") - 8, 8)
                        Else
                            temp_arr(UBound(temp_arr)) = "区工资表"
                        End If
                        dic(total_num) = temp_arr
                        total_num = total_num + 1
                    End If
                Next rowj
            End With
            .Close False
        End With
        Set myobj = Nothing
    Next i
    vtem = Application.Transpose(Application.Transpose(dic.items))
    Set addsht = Sheets.Add(After:=Sheets(Sheets.Count))
    addsht.Name = shtnameStr
    With addsht
        .Range("a1").Resize(, UBound(title_arr) + 1) = title_arr
        .Range("a2").Resize(UBound(vtem, 1), UBound(vtem, 2)).NumberFormatLocal = "@"
        .Range("a2").Resize(UBound(vtem, 1), UBound(vtem, 2)) = vtem
        .Range("a1").CurrentRegion.Columns.AutoFit
        .Range("a1").CurrentRegion.Borders.LineStyle = 1
    End With
End Sub