ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

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

[求助] 求救求救弄了一天了

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-11-8 23:20 | 显示全部楼层 |阅读模式
我想要原表变成第二个横列格式 ,数据很多很多,每个家庭成员不等,有多有少,但不超过8个(因为每个表就8个格),如果有超过的可以另外分一个户,只要是把这些数据按照这样的思路顶满格别出错就行。上次有个大神给弄了下,当时数据简单我以为加列不影响结果,可是加了以后彻底乱了,还请大神帮帮忙,情况紧急啊!或者是把原表数据直接导入将来打印的表都可以。谢谢大神了

上次大神写的丢数据呢有哪位大神帮帮我.zip

230.23 KB, 下载次数: 22

拜托了

TA的精华主题

TA的得分主题

发表于 2019-11-9 08:24 | 显示全部楼层
成员不超过8个,成员包不包含户主?

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-11-9 08:38 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-11-9 09:44 | 显示全部楼层
Jason_WangSS 发表于 2019-11-9 08:24
成员不超过8个,成员包不包含户主?

里面有几户成员确实多点 但是就几户 可以做分户处理 把他们另外分开也可以

TA的精华主题

TA的得分主题

发表于 2019-11-9 09:53 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-11-9 10:10 | 显示全部楼层
请教教我吧 发表于 2019-11-9 09:44
里面有几户成员确实多点 但是就几户 可以做分户处理 把他们另外分开也可以

分开后第一个成员还是填的户主?

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-11-9 10:14 | 显示全部楼层
Jason_WangSS 发表于 2019-11-9 10:10
分开后第一个成员还是填的户主?

是的 第一行还要填写户主,有几个已经超出了8个格,需要再分下户 把里面的成员分一下 以后我自己分也不影响你写的东西会自动写好表格就可以 昨天做数据没来得及看

TA的精华主题

TA的得分主题

发表于 2019-11-9 10:22 | 显示全部楼层
请教教我吧 发表于 2019-11-9 10:14
是的 第一行还要填写户主,有几个已经超出了8个格,需要再分下户 把里面的成员分一下 以后我自己分也不影 ...

可能没明白我的意思,比如这一家 户主是张三,他家10个人,分两行,开头户主重复这个没问题,第二个人的信息,你列的标题写  必须还是户主姓名  ,但这是新起的一行,是否遵循这个规则,还把张三写在 这里

TA的精华主题

TA的得分主题

发表于 2019-11-9 10:47 | 显示全部楼层
  1. Sub 分户()
  2. '将原数据的列顺序做了调整,身份证放在姓名后面,方便数据处理
  3.     Dim aArr, bArr(), tArr(1 To 6)
  4.     aArr = Sheets("原表").[a1].CurrentRegion
  5.     ReDim bArr(1 To 86, 1 To 1)
  6.     For i = 2 To UBound(aArr, 1)
  7.         If aArr(i, 1) = "户主" Then '表头
  8.             n = n + 1
  9.             m = 6
  10.             ReDim Preserve bArr(1 To 86, 1 To n)
  11.             bArr(1, n) = aArr(i, 2) '姓名
  12.             bArr(2, n) = aArr(i, 4) '性别
  13.             bArr(3, n) = aArr(i, 5) '年龄
  14.             bArr(4, n) = aArr(i, 3) '身份证
  15.             bArr(5, n) = aArr(i, 6) '地址
  16.             bArr(6, n) = aArr(i, 7) '电话
  17.         End If
  18.         If m = 86 Then '复制表头
  19.             n = n + 1
  20.             m = 6
  21.             ReDim Preserve bArr(1 To 86, 1 To n)
  22.             For j = 1 To 6
  23.                 bArr(j, n) = bArr(j, n - 1)
  24.             Next
  25.         End If
  26.         For j = 2 To 12
  27.             If j <> 7 Then
  28.                 m = m + 1
  29.                 bArr(m, n) = aArr(i, j)
  30.             End If
  31.         Next
  32.     Next
  33.     Sheets("想变成这样的表").[a2].Resize(UBound(bArr, 2), UBound(bArr, 1)) = WorksheetFunction.Transpose(bArr) '输出到"想变成这样的表",其他位置可自行指定
  34. End Sub

复制代码


不问了,猜一个,原表的顺序要调整一下,身份证列移动到姓名列后面

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-11-9 15:45 | 显示全部楼层
Jason_WangSS 发表于 2019-11-9 10:47
不问了,猜一个,原表的顺序要调整一下,身份证列移动到姓名列后面

谢谢你 我给试一试
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

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

GMT+8, 2019-11-12 11:20 , Processed in 0.064488 second(s), 15 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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