欲哭无泪，谁能帮帮我

zldccmx · 发表于 2009-7-18 13:45

农户信息表.rar (35 KB, 下载次数: 48)
请按这个附件进行操作！

zldccmx · 发表于 2009-7-18 13:47

这个要求并不难，难就难在数据对应关系
花了一上午的时候，将你的数据对应关系理清楚了。
由于使用公式会严重消耗时间，所以就全部使用了VBA来完成！

icelan2008 · 发表于 2009-7-18 14:00

向老朽学习，有深度，有钻研精神。

李子然 · 发表于 2009-7-18 14:08

原帖由 zldccmx 于 2009-7-18 13:43 发表
纯VBA制作，没有使用公式

Option Explicit

   '撰写:老朽
   '网址:http://Club.ExcelHome.net
   '日期:2009-7-18 下午 01:42:20
Sub zldccmx()
Application.ScreenUpdating = False
  ...

老朽的编程不错，搞得我一堆垃圾xls文件

alzeng · 发表于 2009-7-18 14:11

用一个工作簿做跳板，应该算是比较简单的做法了。点击“农户信息表”中的“拆分新表”按钮，即批量生成新表。
在这个应用中，其实可以充分利用原有的查询代码，遍历身份证号后将查询结果生成新工作簿。这样代码短小，运行速度也比较快。

附件已修正：

批量拆分表.rar (38.49 KB, 下载次数: 34)

Private Sub CommandButton1_Click()
Dim str$, stg$, rng As Range
Dim Sh As Worksheet, Sht As Worksheet
Dim wk$
Set Sh = ThisWorkbook.Sheets("附件5.1")
Set Sht = ThisWorkbook.Sheets("附件5.2")
wk = ThisWorkbook.Path & "\Model.xls"
For Each rng In Range("B3", [B65536].End(3))
str = rng
stg = rng.Offset(, 1)
Sh.[A2] = str
Workbooks.Open Filename:=wk
With ActiveWorkbook
.Sheets("1").[A3].Resize(34, 25).Value = Sh.[A7].Resize(34, 25).Value
.Sheets("2").[A4].Resize(33, 11).Value = Sht.[A8].Resize(33, 11).Value
.SaveAs Filename:=ThisWorkbook.Path & "" & stg & ".xls"
.Close Save = True
End With
Next
End Sub

复制代码

[ 本帖最后由 alzeng 于 2009-7-18 14:55 编辑 ]

与心 · 发表于 2009-7-18 14:13

原帖由 zldccmx 于 2009-7-18 13:47 发表
这个要求并不难，难就难在数据对应关系
花了一上午的时候，将你的数据对应关系理清楚了。
由于使用公式会严重消耗时间，所以就全部使用了VBA来完成！

真心的谢谢您，老朽大哥！我下载了你做的附件，小妹我还是不太懂的，要怎么做才能把里面所有的用户都分离出来变成一户家庭一个excel文档的？我点了“拆分成个人表”就会自动关闭然后再重启，不明白什么意思？怎么样才能把每一户的信息分离出来变成一个独立的excel文档，里面只含有5.1跟5.2的附件？
谢谢您，帮我解决问题。

与心 · 发表于 2009-7-18 14:18

原帖由 alzeng 于 2009-7-18 14:11 发表
用一个工作簿做跳板，应该算是比较简单的做法了。点击“农户信息表”中的“拆分新表”按钮，即批量生成新表。
550629

谢谢您！我看了您做的方案，很感激这里每一位热心的朋友，谢谢你们。我刚试了您帮我做的表，附件1没有问题，可是附件2里却出现了错误，请再帮我看看好吗？这个方法很好，可惜附件2出错了…再次谢谢你，好心人

icelan2008 · 发表于 2009-7-18 14:23

原帖由与心于 2009-7-18 14:13 发表

真心的谢谢您，老朽大哥！我下载了你做的附件，小妹我还是不太懂的，要怎么做才能把里面所有的用户都分离出来变成一户家庭一个excel文档的？我点了“拆分成个人表”就会自动关闭然后再重启，不明白什么意思？怎么样 ...

Nwk.SaveAs "D:\" & Arr(I, 3) & ".XLS"
分开的文件放在你的D盘下！

与心 · 发表于 2009-7-18 14:30

原帖由 icelan2008 于 2009-7-18 14:23 发表

Nwk.SaveAs "D:\" & Arr(I, 3) & ".XLS"
分开的文件放在你的D盘下！

谢谢您，我已经找到了，不过好象有点问题，一些表里出现了重复的数据。我上传的是一个简单的复件，不知道要怎么把这个功能加到新的表里去实现这个功能？

alzeng · 发表于 2009-7-18 14:40

原帖由与心于 2009-7-18 14:18 发表

谢谢您！我看了您做的方案，很感激这里每一位热心的朋友，谢谢你们。我刚试了您帮我做的表，附件1没有问题，可是附件2里却出现了错误，请再帮我看看好吗？这个方法很好，可惜附件2出错了…再次谢谢你，好心人

更新了附件，主要是Sht写成了Sh。

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

[求助] 欲哭无泪，谁能帮帮我