Excel精英培训网

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

[已解决]用VBA数组把sheet2每一行拆开保存sheet1

[复制链接]
发表于 2017-4-15 22:36 | 显示全部楼层 |阅读模式
本帖最后由 laoau138 于 2017-4-16 09:14 编辑

用VBA数组把sheet2每一行拆开保存sheet1

最佳答案
2017-4-15 23:20
  1. Sub aaa()
  2. Dim arr, brr, crr, i&, j&, n&
  3. arr = [a1].CurrentRegion
  4. n = Application.Sum(Application.Index(arr, , 3))
  5. ReDim brr(1 To n * 10, 1 To UBound(arr, 2))
  6. n = 0
  7. For i = 1 To UBound(arr)
  8.   crr = Split(arr(i, 4), ",")
  9.   For j = 0 To UBound(crr)
  10.     If crr(j) = "" Then Exit For
  11.     n = n + 1
  12.     brr(n, 1) = arr(i, 1)
  13.     brr(n, 2) = arr(i, 2)
  14.     If j = 0 Then brr(n, 3) = arr(i, 3)
  15.     brr(n, 4) = crr(j) & ","
  16.   Next j
  17. Next i
  18. Sheets(1).[a1].Resize(UBound(brr), UBound(brr, 2)) = brr
  19. End Sub
复制代码

用VBA数组把sheet2每一行拆开保存sheet1.rar

6.8 KB, 下载次数: 9

发表于 2017-4-15 23:20 | 显示全部楼层    本楼为最佳答案   
  1. Sub aaa()
  2. Dim arr, brr, crr, i&, j&, n&
  3. arr = [a1].CurrentRegion
  4. n = Application.Sum(Application.Index(arr, , 3))
  5. ReDim brr(1 To n * 10, 1 To UBound(arr, 2))
  6. n = 0
  7. For i = 1 To UBound(arr)
  8.   crr = Split(arr(i, 4), ",")
  9.   For j = 0 To UBound(crr)
  10.     If crr(j) = "" Then Exit For
  11.     n = n + 1
  12.     brr(n, 1) = arr(i, 1)
  13.     brr(n, 2) = arr(i, 2)
  14.     If j = 0 Then brr(n, 3) = arr(i, 3)
  15.     brr(n, 4) = crr(j) & ","
  16.   Next j
  17. Next i
  18. Sheets(1).[a1].Resize(UBound(brr), UBound(brr, 2)) = brr
  19. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2017-4-15 23:42 | 显示全部楼层
回复

使用道具 举报

发表于 2017-4-15 23:46 | 显示全部楼层
我的代码可能错吗?你套用的数据传上来。
另ReDim brr(1 To n * 10, 1 To UBound(arr, 2))
里面的*10是调试用的,去掉,当然跟你说的错误没关系。
回复

使用道具 举报

 楼主| 发表于 2017-4-16 09:13 | 显示全部楼层
大灰狼1976 发表于 2017-4-15 23:46
我的代码可能错吗?你套用的数据传上来。
另ReDim brr(1 To n * 10, 1 To UBound(arr, 2))
里面的*10是调 ...

原来这个表的关系,代码没有错
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 17:34 , Processed in 0.354252 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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