求救求救弄了一天了

请教教我吧 · 发表于 2019-11-8 23:20

我想要原表变成第二个横列格式，数据很多很多，每个家庭成员不等，有多有少，但不超过8个（因为每个表就8个格），如果有超过的可以另外分一个户，只要是把这些数据按照这样的思路顶满格别出错就行。上次有个大神给弄了下，当时数据简单我以为加列不影响结果，可是加了以后彻底乱了，还请大神帮帮忙，情况紧急啊！或者是把原表数据直接导入将来打印的表都可以。谢谢大神了

Jason_WangSS · 发表于 2019-11-9 08:24

成员不超过8个，成员包不包含户主？

请教教我吧 · 发表于 2019-11-9 08:38

Jason_WangSS 发表于 2019-11-9 08:24
成员不超过8个，成员包不包含户主？

户主也要算成员

请教教我吧 · 发表于 2019-11-9 09:44

Jason_WangSS 发表于 2019-11-9 08:24
成员不超过8个，成员包不包含户主？

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

sirsunny · 发表于 2019-11-9 09:53

把上次的办法拿粗来参考参考。

Jason_WangSS · 发表于 2019-11-9 10:10

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

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

请教教我吧 · 发表于 2019-11-9 10:14

Jason_WangSS 发表于 2019-11-9 10:10
分开后第一个成员还是填的户主?

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

Jason_WangSS · 发表于 2019-11-9 10:22

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

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

Jason_WangSS · 发表于 2019-11-9 10:47

Sub 分户()
'将原数据的列顺序做了调整,身份证放在姓名后面,方便数据处理
Dim aArr, bArr(), tArr(1 To 6)
aArr = Sheets("原表").[a1].CurrentRegion
ReDim bArr(1 To 86, 1 To 1)
For i = 2 To UBound(aArr, 1)
If aArr(i, 1) = "户主" Then '表头
n = n + 1
m = 6
ReDim Preserve bArr(1 To 86, 1 To n)
bArr(1, n) = aArr(i, 2) '姓名
bArr(2, n) = aArr(i, 4) '性别
bArr(3, n) = aArr(i, 5) '年龄
bArr(4, n) = aArr(i, 3) '身份证
bArr(5, n) = aArr(i, 6) '地址
bArr(6, n) = aArr(i, 7) '电话
End If
If m = 86 Then '复制表头
n = n + 1
m = 6
ReDim Preserve bArr(1 To 86, 1 To n)
For j = 1 To 6
bArr(j, n) = bArr(j, n - 1)
Next
End If
For j = 2 To 12
If j <> 7 Then
m = m + 1
bArr(m, n) = aArr(i, j)
End If
Next
Next
Sheets("想变成这样的表").[a2].Resize(UBound(bArr, 2), UBound(bArr, 1)) = WorksheetFunction.Transpose(bArr) '输出到"想变成这样的表",其他位置可自行指定
End Sub

复制代码

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

请教教我吧 · 发表于 2019-11-9 15:45

Jason_WangSS 发表于 2019-11-9 10:47
不问了,猜一个,原表的顺序要调整一下,身份证列移动到姓名列后面

谢谢你我给试一试

		自动登录	找回密码
密码			免费注册

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

最新热点 /1