ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 239|回复: 4

求助高手,用VBA新建工作表怎么按要求导入数据?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-7-16 14:18 | 显示全部楼层 |阅读模式
大家好,我对这个VBA实在是弄不太明白,而现在手头有点任务确实又需要用到这个,否则要浪费很多时间才行。我的具体的需要达到的效果就是:以某个工作表的内容为模板,批量新建多个工作表,而建几个工作表以另一个原始数据表里面的户数来定。表格名称以001开始,对应原始数据表里面的001户,以此类推。而新建工作表后,要在新建表里面的空表里面导入相对应的原始数据表里面的内容。比如001这个工作表,里面的内容有两个,上下对应村与村民小组的,姓名身份证这些是001这户的所有人的数据,只有后面的分享的股金不同。都是可以在原始数据表里面导入进来的。001表导入数据表里面的对应的001户的所有人,其他类推。
说明:附件内容第一个工作表是原始要导入的数据,第二个001表就是我新建的一个工作表,里面的内容按此导入。接下来就是002,003,004,------

原始资料.rar

24.02 KB, 下载次数: 6

TA的精华主题

TA的得分主题

发表于 2019-7-22 13:24 来自手机 | 显示全部楼层
本帖最后由 守护最爱的坤坤 于 2019-7-22 17:11 编辑

Public Sub test()
Application.ScreenUpdating = False '关闭屏幕更新
    With Worksheets("001")
        .Name = "模板表" '把001表改名为模板表,方便后面直接选择活动工作表进行数据输入
.Range("c6:c15,d6:f14,e15:f15,c17:c26,d17:f25,e26:f26").ClearContents '清除模板表指定区域的内容
        .Range("e6:e15,e17:e26").NumberFormat = "general" '设置模板表相应区域单元格格式为常规
        .Range("f6:f15,f17:f26").NumberFormat = "0.00"    '设置模板表相应区域单元格格式为“0.00”
    End With
  Dim arr, arr1 'arr1储存源数据表a列所有数据及第一个空单元格,arr储存源数据表除a列和标题外所有数据
    Dim arow As Long
    arow = Range("a65536").End(xlUp).Row
    ReDim arr1(3 To arow + 1)
    ReDim arr(3 To arow + 1, 2 To 7)
    Dim i As Long, m As Integer
    For i = 3 To arow + 1
        arr1(i) = Format(Worksheets("sheet1").Range("a" & i).Value, "000")
        For m = 2 To 7
            arr(i, m) = Worksheets("sheet1").Cells(i, m).Value
        Next m
    Next i
    Dim lastrow As Long 'lastrow存储每一户最后一位家庭成员所在单元格行号
    Dim renkou As Integer
    renkou = 1 'renkou储存每一户家庭人口数,每一户至少为1人
    Dim addrow As Integer 'addrow为添加行过程的循环变量
    Dim charuhang As Integer 'charuhang即插入行,记录插入的行数
    charuhang = 0 '初始化插入行
    Dim huzhu As Long  'huzhu储存每一户户主所在单元格行号
    Dim lie As Integer 'lie为户主那一行各个单元格列号
  Dim tianhang As Integer
    Dim tianlie As Integer 'tianruhang,tianrulie分别为需要填入数据的单元格所要填入的数据在源数据表中的行号和列号
    Dim arrs, arrx
    For lastrow = 3 To arow
        If arr1(lastrow) = arr1(lastrow + 1) Then
            renkou = renkou + 1
        Else'边建表边填数据
            Worksheets("模板表").Copy after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = arr1(lastrow)  '新建工作表并重命名
            If renkou > 1 Then '当人口大于1时,户主可能不在该户的第一个,通过循环把户主所在行数据与第一位家庭成员交换,方便后面输入数据
                For huzhu = lastrow - renkou + 1 To lastrow '通过循环得到huzhu即户主所在单元格行号
                    If arr(huzhu, 2) = arr(huzhu, 3) Then
                        For lie = 3 To 7
                            Dim s As Variant
                            s = arr(huzhu, lie)
                            arr(huzhu, lie) = arr(lastrow - renkou + 1, lie)
                            arr(lastrow - renkou + 1, lie) = s
                        Next lie
                    End If
                Next huzhu
            End If
            If renkou > 9 Then '判断单元格是否足够填入,不够则添加行至足够,因为有些家庭可能人口比较多
                For addrow = 1 To renkou - 9
                    ActiveSheet.Rows(13).Insert
                    ActiveSheet.Rows(24).Insert
                    charuhang = charuhang + 1
                Next addrow
            End If
            '准备工作完成,下面进行数据输入,脑壳疼,先把要填入的数据分别放到数组arrs和arrx里
            ReDim arrs(lastrow - renkou + 1 To lastrow, 3 To 6), arrx(lastrow - renkou + 1 To lastrow, 3 To 6)
                For tianhang = lastrow - renkou + 1 To lastrow
                    For tianlie = 3 To 6
                        arrx(tianhang, tianlie) = arr(tianhang, tianlie)
                        If tianlie = 6 Then
                            arrs(tianhang, tianlie) = arr(tianhang, 7)
                        Else
                            arrs(tianhang, tianlie) = arr(tianhang, tianlie)
                        End If
                    Next tianlie
                Next tianhang
            With ActiveSheet '现在开始填数据
                .Range("c6").Resize(renkou, 4).Value = arrs
                .Range("c" & 17 + charuhang).Resize(renkou, 4).Value = arrx
                .Range("c" & 15 + charuhang).Value = renkou
                .Range("c" & 26 + charuhang * 2).Value = renkou
                .Range("e" & 15 + charuhang).Value = WorksheetFunction.Sum(.Range("e6").Resize(renkou, 1).Value)
                .Range("e" & 26 + charuhang * 2).Value = WorksheetFunction.Sum(.Range("e" & 17 + charuhang).Resize(renkou, 1).Value)
                .Range("f" & 15 + charuhang).Value = WorksheetFunction.Sum(.Range("f6").Resize(renkou, 1).Value)
                .Range("f" & 26 + charuhang * 2).Value = WorksheetFunction.Sum(.Range("f" & 17 + charuhang).Resize(renkou, 1).Value)
            End With
            Erase arrs
            Erase arrx
            charuhang = 0
            renkou = 1 'renkou要储存下一户人口数,因此应重新赋值为1
        End If
         Next lastrow
    Application.ScreenUpdating = True
End Sub

TA的精华主题

TA的得分主题

发表于 2019-7-22 13:25 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-7-22 13:26 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-7-25 13:37 | 显示全部楼层
守护最爱的坤坤 发表于 2019-7-22 13:24
Public Sub test()
Application.ScreenUpdating = False '关闭屏幕更新
    With Worksheets("001")

谢谢你,你的代码我放到里面执行了,可以达到目的,不过有一个小问题就是,我的模板其实是以里面的000为模板,并不是001为模板,001是建立新表达到的效果,里面的D4单元格,股权证书编号按你这个执行后全部都是001里面的050406001这个编号,这个编号是随着户编号变化的,也就是002工作表这个编号也要变为050406002,直到最后一个。不知道这个怎么做。谢谢 另外我还想问一下简单的操作,也就是说所有的工作表都建立好了,单独从数据表里面导入数据,也就是导入每户人员和D4单元格的编号随着变这个又怎么操作?按数据表里面的户编号001直到末的,一个一个对应的单独的导入数据。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-4-5 21:43 , Processed in 0.077332 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表