如何将一列中许多相同名称下间隔中单元格数值提取到一个固定格式的表中

905679689 · 发表于 2020-2-21 22:37

本帖最后由 905679689 于 2020-2-22 09:20 编辑

求助，如何将“提取表”中E列下户主和下一个户主间B至E列的值提取到“要生成的表”中的6行以下，要以每户新建一个表。大概有8000户左右，求助各位老师帮忙看看能否解决。附件含有两个表，提取新表“要生成[url=]附件[/url]的表”表头是一致的的。

3190496160 · 发表于 2020-2-22 07:49

你提取表中的户号不是真实的吧，按理，同一户的人，户号应该是一样的呀，所以，你的问题，根据户号来拆分就行了，
布白村委会，阿矣坎村，非常熟悉呀，呵呵

microyip · 发表于 2020-2-22 09:05

录制一个宏，修改一下行数进行循环就可以啦

905679689 · 发表于 2020-2-22 09:10

3190496160 发表于 2020-2-22 07:49
你提取表中的户号不是真实的吧，按理，同一户的人，户号应该是一样的呀，所以，你的问题，根据户号来拆分就 ...

信息要保密，问题是用户号循环提取后生成新表你有什么高见。

905679689 · 发表于 2020-2-22 09:11

microyip 发表于 2020-2-22 09:05
录制一个宏，修改一下行数进行循环就可以啦

我试试看，就是生成每个单独的表不熟悉。

chxw68 · 发表于 2020-2-22 09:25

Sub test()
Dim r%, i%, m%
Dim arr, brr, zrr()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Worksheets("汇总")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a1:p" & r)
m = 0
For i = 2 To UBound(arr)
If arr(i, 5) = "户主" Then
m = m + 1
ReDim Preserve zrr(1 To 2, 1 To m)
zrr(1, m) = i
zrr(2, m) = i
Else
If m <> 0 Then
zrr(2, m) = i
End If
End If
Next
End With
With Worksheets("非卡户")
For k = 1 To UBound(zrr, 2)
.Range("c6:r9") = Empty
.Columns(4).NumberFormatLocal = "@"
ReDim brr(1 To zrr(2, k) - zrr(1, k) + 1, 1 To 5)
m = 0
For i = zrr(1, k) To zrr(2, k)
m = m + 1
brr(m, 1) = arr(i, 2)
brr(m, 2) = arr(i, 11)
brr(m, 3) = arr(i, 3)
brr(m, 4) = arr(i, 4)
brr(m, 5) = arr(i, 5)
Next
.Range("a6").Resize(UBound(brr), UBound(brr, 2)) = brr
.Copy
With ActiveWorkbook
.SaveAs Filename:=ThisWorkbook.Path & "" & brr(1, 3)
.Close False
End With
Next
End With
End Sub

复制代码

chxw68 · 发表于 2020-2-22 09:25

详见附件。

jjmysjg · 发表于 2020-2-22 22:39

实用，留下记号

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

[求助] 如何将一列中许多相同名称下间隔中单元格数值提取到一个固定格式的表中

评分

最新热点 /1