Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 3978|回复: 6

[已解决]求好心人帮助 EXCEL 数据批量导入固定模板中

[复制链接]
发表于 2014-3-14 16:57 | 显示全部楼层 |阅读模式
附件已上传
自己写了一下 用三维数组 定位 每户数据
搞到最后 搞到头大
求帮助  或提供思路

最佳答案
2014-3-14 17:56
请看附件。因为家庭成员有合并单元格的问题,显示略有问题。建议把家庭成员中的合并单元格去掉,估计就没问题了。

test.rar

7.56 KB, 下载次数: 29

 楼主| 发表于 2014-3-14 17:01 | 显示全部楼层
回复

使用道具 举报

发表于 2014-3-14 17:54 | 显示全部楼层
  1.     Dim Sh As Worksheet
  2.     Set d = CreateObject("scripting.dictionary")
  3.     Set Sh = Sheet1
  4.     arr = Sh.[a1].CurrentRegion
  5.     For i = 2 To UBound(arr)
  6.         bh = arr(i, 2)     '编号
  7.         xm = arr(i, 3)
  8.         d(bh) = d(bh) & "," & i         '把相同编号的行数存入字典
  9.     Next
  10.     dk = d.keys: dt = d.items
  11.     Dim brr(1 To 18, 1 To 9)  '家庭成员
  12.     Dim crr(1 To 27, 1 To 9)  '地籍信息
  13.     For i = 0 To UBound(dk)
  14.         Sheets("模板").Copy after:=Sheets(Sheets.Count)
  15.         xrr = Split(dt(i), ",")
  16.         rk = 0: dj = 0   '人口、地籍数置0
  17.         With ActiveSheet
  18.             For k = 1 To UBound(xrr)
  19.                 r = Val(xrr(k))
  20.                 xm = arr(r, 3)
  21.                 If Len(arr(r, 12)) > 0 Then
  22.                     rk = rk + 1
  23.                     brr(rk, 1) = arr(r, 12): brr(rk, 2) = arr(r, 14)
  24.                     brr(rk, 4) = arr(r, 15): brr(rk, 8) = arr(r, 16)
  25.                 End If
  26.                 dj = dj + 1
  27.                 crr(dj, 1) = arr(r, 11) '地框名称
  28.                 crr(dj, 2) = arr(r, 1) '宗地编号
  29.                 For j = 3 To 9
  30.                     crr(dj, j) = arr(r, j + 1)
  31.                 Next
  32.             Next
  33.             .Name = xm
  34.             .[b2] = dk(i)
  35.             .[e2] = xm
  36.             .[h2] = rk
  37.             .[a5].Resize(rk, 4) = brr
  38.             .[a26].Resize(dj, 9) = crr
  39.         End With
  40.     Next
  41. End Sub
复制代码
回复

使用道具 举报

发表于 2014-3-14 17:56 | 显示全部楼层    本楼为最佳答案   
请看附件。因为家庭成员有合并单元格的问题,显示略有问题。建议把家庭成员中的合并单元格去掉,估计就没问题了。

test.rar

15.77 KB, 下载次数: 57

回复

使用道具 举报

发表于 2014-3-14 19:39 | 显示全部楼层
本帖最后由 zjdh 于 2014-3-14 19:46 编辑

一点小问题:
.[a5].Resize(rk, 8) = brr

回复

使用道具 举报

 楼主| 发表于 2014-3-15 09:34 | 显示全部楼层
本帖最后由 neykove 于 2014-3-15 10:58 编辑
grf1973 发表于 2014-3-14 17:56
请看附件。因为家庭成员有合并单元格的问题,显示略有问题。建议把家庭成员中的合并单元格去掉,估计就没问 ...





回复

使用道具 举报

发表于 2014-3-17 09:10 | 显示全部楼层
zjdh 发表于 2014-3-14 19:39
一点小问题:
.[a5].Resize(rk, 8) = brr

呵呵,我说怎么家庭成员的备注栏没显现,还以为是合并单元格的问题呢。改过就OK了。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 21:34 , Processed in 1.105617 second(s), 12 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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