Excel精英培训网

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

[已解决]跪求大神来段代码

[复制链接]
发表于 2017-5-18 11:07 | 显示全部楼层 |阅读模式
求个好心的大神  SHEET1中根据派出所ID竖向排列的各户,重新按照户主横向排列在SHEET3中,第一户已经做好,求大神来段能自动吧剩余几户自动排列的代码。PS.保密原因,身份证号码已更换为数字;同一户的派出所ID一致
最佳答案
2017-5-18 11:28
  1. Sub Grf()
  2.     arr = Sheets(1).[a1].CurrentRegion
  3.     ReDim brr(1 To UBound(arr), 1 To 40)
  4.     For i = 2 To UBound(arr)
  5.         If arr(i, 7) = "户主" Then
  6.             n = n + 1: k = 0
  7.             brr(n, 1) = arr(i, 1)
  8.             brr(n, 2) = arr(i, 6)
  9.             brr(n, 3) = arr(i, 2)
  10.             brr(n, 4) = arr(i, 3) & arr(i, 4)
  11.         Else
  12.             k = k + 1: j = 4 * k + 1
  13.             If jmax < j Then jmax = j
  14.             brr(n, j) = arr(i, 1)
  15.             brr(n, j + 1) = arr(i, 2)
  16.             brr(n, j + 2) = arr(i, 7)
  17.             brr(n, j + 3) = arr(i, 9)
  18.         End If
  19.     Next
  20.     [a2].Resize(n, jmax + 3) = brr
  21.     ActiveSheet.Columns.AutoFit
  22. End Sub
复制代码

石婆桥4组.rar

13.19 KB, 下载次数: 3

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2017-5-18 11:28 | 显示全部楼层    本楼为最佳答案   
  1. Sub Grf()
  2.     arr = Sheets(1).[a1].CurrentRegion
  3.     ReDim brr(1 To UBound(arr), 1 To 40)
  4.     For i = 2 To UBound(arr)
  5.         If arr(i, 7) = "户主" Then
  6.             n = n + 1: k = 0
  7.             brr(n, 1) = arr(i, 1)
  8.             brr(n, 2) = arr(i, 6)
  9.             brr(n, 3) = arr(i, 2)
  10.             brr(n, 4) = arr(i, 3) & arr(i, 4)
  11.         Else
  12.             k = k + 1: j = 4 * k + 1
  13.             If jmax < j Then jmax = j
  14.             brr(n, j) = arr(i, 1)
  15.             brr(n, j + 1) = arr(i, 2)
  16.             brr(n, j + 2) = arr(i, 7)
  17.             brr(n, j + 3) = arr(i, 9)
  18.         End If
  19.     Next
  20.     [a2].Resize(n, jmax + 3) = brr
  21.     ActiveSheet.Columns.AutoFit
  22. End Sub
复制代码

石婆桥4组.rar

21.27 KB, 下载次数: 3

回复

使用道具 举报

 楼主| 发表于 2017-5-18 16:30 | 显示全部楼层
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 19:34 , Processed in 1.226450 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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