专栏首页闷骚的程序员用 VBA 将多个 Excel 文件里的数据汇总到一个 Excel 表

用 VBA 将多个 Excel 文件里的数据汇总到一个 Excel 表

需求

给出一个空汇总表,和若干单独的 Excel 文件,每个文件里头有一个表格里存有一个人的信息,要将这些文件里的信息全部对应地导入到汇总表里。

以前写的,也不给实际例子了,直接上代码,逻辑不复杂,看看就明白。记在这里备以后查。

代码

Sub ExportMyFile()
    Dim myPath, myFileName
    Dim myCurOpenWB As Workbook 'work工作簿
    Dim myCurOpenWS As Worksheet 'work工作表
    Dim myTotalWS As Worksheet '汇总工作表
    
    Dim myFolderName As String
    myFolderName = "六堰"
    
    Set myTotalWS = ThisWorkbook.Sheets("附件4")    '汇总到表名为附件4的表格里
    
    myPath = ThisWorkbook.Path & "/" & myFolderName & "/*.xls"
    myFileName = Dir(myPath)   '''''''''''''''''''''''''''''''''''
    'Dim iCounter As Integer
    'iCounter = 0
    
    '遍历指定目录下的文件并操作
    Do '''''''''''''''''''''''''''''''''''''
        Debug.Print myFileName
        
        Dim searchStr As String '通用搜索字符串
        Dim resStr As String '通用结果字符串
        Dim iCount As Integer '通用计数器
        
        myFileName = ThisWorkbook.Path & "/" & myFolderName & "/" & myFileName
        
        '打开指定目录里的一个*.xls文件
        'Debug.Print myFileName
        Set myCurOpenWB = Workbooks.Open(myFileName)
        Set myCurOpenWS = myCurOpenWB.Sheets("附件1")   '打开文件的sheet附件1里是分条数据
        
        '插入内容行
        Dim iC As Integer
        For iC = 0 To 3
            '插入内容行
            myTotalWS.Rows(6).Insert
            myTotalWS.Rows(6).RowHeight = 14.25
            myTotalWS.Range("B6:Q6").NumberFormat = "@"   '将它们的数字格式设置成文本
        Next
        
        '##################################复制数据过程######################################
        '序号 =Row()-5
        myTotalWS.Range("A6").Formula = "=INT(Row()/4)"
        
        '姓名   C4
        myTotalWS.Range("B6").Value = myCurOpenWS.Range("C4").Value

        '性别   F4
        myTotalWS.Range("C6").Value = myCurOpenWS.Range("F4").Value
        
        '出生年月   C6
        myTotalWS.Range("D6").Value = myCurOpenWS.Range("C6").Value
        
        '身份证 D8
        myTotalWS.Range("E6").Value = myCurOpenWS.Range("D8").Value
        
        '进厂劳动时间   B21-B25
        myTotalWS.Range("F6").Value = myCurOpenWS.Range("B21").Value
        myTotalWS.Range("F7").Value = myCurOpenWS.Range("B22").Value
        myTotalWS.Range("F8").Value = myCurOpenWS.Range("B23").Value
        myTotalWS.Range("F9").Value = myCurOpenWS.Range("B24").Value
        
        '离岗时间   B21-B25
        
        '劳动年限   I26
        myTotalWS.Range("H6").Value = myCurOpenWS.Range("I26").Value
        
        '原用工单位 D21-D25
        'myTotalWS.Range("I6").Value = myFolderName
        myTotalWS.Range("I6").Value = myCurOpenWS.Range("D21").Value
        myTotalWS.Range("I7").Value = myCurOpenWS.Range("D22").Value
        myTotalWS.Range("I8").Value = myCurOpenWS.Range("D23").Value
        myTotalWS.Range("I9").Value = myCurOpenWS.Range("D24").Value
        
        '用工类别   D26
        myTotalWS.Range("J6").Value = "家属工"
        
        '已享受保障 B28-B30
        searchStr = myCurOpenWS.Range("B28").Value
        resStr = ""
        iCount = 0
        If InStr(searchStr, "√") <> 0 Then
            resStr = resStr & "城市最低生活保障"
            iCount = iCount + 1
        End If
        searchStr = myCurOpenWS.Range("B29").Value
        If InStr(searchStr, "√") <> 0 Then
            If iCount <> 0 Then
                resStr = resStr & "、"
            End If
            resStr = resStr & "遗属生活困难补助"
            iCount = iCount + 1
        End If
        searchStr = myCurOpenWS.Range("B30").Value
        If InStr(searchStr, "√") <> 0 Then
            If iCount <> 0 Then
                resStr = resStr & "、"
            End If
            resStr = resStr & "供养亲属抚恤费"
        End If
        myTotalWS.Range("K6").Value = resStr
        
        '已参加社保 B32-B34
        searchStr = myCurOpenWS.Range("B32").Value
        resStr = ""
        iCount = 0
        If InStr(searchStr, "√") <> 0 Then
            resStr = resStr & "企业职工养老保险"
            iCount = iCount + 1
        End If
        searchStr = myCurOpenWS.Range("B33").Value
        If InStr(searchStr, "√") <> 0 Then
            If iCount <> 0 Then
                resStr = resStr & "、"
            End If
            resStr = resStr & "灵活就业人员养老保险"
            iCount = iCount + 1
        End If
        searchStr = myCurOpenWS.Range("B34").Value
        If InStr(searchStr, "√") <> 0 Then
            If iCount <> 0 Then
                resStr = resStr & "、"
            End If
            resStr = resStr & "城镇居民医疗保险"
        End If
        myTotalWS.Range("L6").Value = resStr
        
        '配偶姓名   C10
        myTotalWS.Range("M6").Value = myCurOpenWS.Range("C10").Value
        
        '配偶现所在单位
        myTotalWS.Range("N6").Value = "重型车厂"
        
        '配偶人员类别   C12
        'myTotalWS.Range("O6").Value = myCurOpenWS.Range("C12").Value
        searchStr = myCurOpenWS.Range("C12").Value
        If InStr(searchStr, "√去世") <> 0 Then
            myTotalWS.Range("O6").Value = "去世"
        ElseIf InStr(searchStr, "√离休") <> 0 Then
            myTotalWS.Range("O6").Value = "离休"
        ElseIf InStr(searchStr, "√退休") <> 0 Then
            myTotalWS.Range("O6").Value = "退休"
        ElseIf InStr(searchStr, "√退养") <> 0 Then
            myTotalWS.Range("O6").Value = "退养"
        Else
            myTotalWS.Range("O6").Value = "在职"
        End If
        

        '备注
        myTotalWS.Range("P6").Value = myFolderName
        
        '联系电话
        myTotalWS.Range("Q6").Value = myCurOpenWS.Range("H18").Value

        '################################复制数据过程结束#############################
        
        '关闭打开的文件
        myCurOpenWB.Close
                
        myFileName = Dir   ''''''''''''''''''''''''''''''
    '    iCounter = iCounter + 1
    Loop Until myFileName = "" '''''''''''''''''''''''''''''
    
End Sub

本文参与腾讯云自媒体分享计划,欢迎正在阅读的你也加入,一起分享。

我来说两句

0 条评论
登录 后参与评论

相关文章

  • VBA 在 Excel 中的常用操作

    设置单元格 Value 里使用 Chr(10) 和 Chr(13),分别表示回车、换行。

    mzlogin
  • 可执行文件名中包含 install 或 setup

    在 Windows Vista+ 系统下,若 EXE 文件名中包含有「install」、「update」或「setup」等字样,可能出现如下问题:

    mzlogin
  • CSDN 已下载资源自动批量评论脚本

    用 Python 实现自动批量打分评论指定 CSDN 账号内所有下载过待评论的资源。

    mzlogin
  • Excel应用实践03:使用Excel进行个人计划执行记录与统计分析

    一转眼,2019年已至4月,自从年初立下flag后,便努力朝着实现它的方向奔跑。有些执行得很好,比如每天更新完美Excel微信公众号,坚持每天学习,而有些则还没...

    fanjy
  • Swift 区间运算符

    目前有时间,打算复习一下Swift,打算抽时间写个Swift基础教程系列。今天就说一下区间运算符。

    赵哥窟
  • Python之双色球选购和三级菜单问题

    1:双色球选购 # 1 双色球(假设一共八个球,6个红球,球号1-32、2个蓝球,球号1-16) # 2 确保用户不能重复选择,不能超出范围 # 3 用户输入...

    py3study
  • 单行多行文本溢出显示的省略号 原

    (adsbygoogle = window.adsbygoogle || []).push({});

    tianyawhl
  • Centos下添加静态路由(临时和永久有效)的操作记录

    公司IDC机房服务器上部署了一套外网LB环境,默认配置的是外网ip的路由地址,由于要和其他内网机器通信,所以需要配置内网ip的路由地址。整个操作过程,记录如下,...

    洗尽了浮华
  • “年轻时尚且议题不断”的两会,VR/AR、5G、4K、AI频繁被Cue!

    近期,两会正在火热召开中,国内外目光均聚焦于此。而VR/AR、5G、4K、AI等展露锋芒的黑科技,也吸引不少眼球,频繁被Cue。各方真可谓上演了一番“科技看家本...

    VRPinea
  • 对Javascript 类、原型链、继承的理解

      和其他面向对象的语言(如Java)不同,Javascript语言对类的实现和继承的实现没有标准的定义,而是将这些交给了程序员,让程序员更加灵活地(当然刚开始...

    smy

扫码关注云+社区

领取腾讯云代金券