Excel精英培训网

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

[已解决]数据分解到指定表格的VBA代码如何写呢

[复制链接]
发表于 2014-4-8 21:24 | 显示全部楼层 |阅读模式
附件下载: 新建文件夹 (2).rar (173.24 KB, 下载次数: 3)
发表于 2014-4-8 21:43 | 显示全部楼层
回复

使用道具 举报

发表于 2014-4-8 21:46 | 显示全部楼层
  1. Sub Macro1()
  2. Dim arr, brr, i&, j%
  3. arr = Range("a1:b" & Range("a65536").End(xlUp).Row)
  4. x = [c1]
  5. ReDim brr(1 To UBound(arr), 1 To 6)
  6. For i = 1 To UBound(arr)
  7.     brr(i, 1) = arr(i, 1)
  8.     brr(i, 6) = arr(i, 2)
  9.     For j = 1 To Len(x)
  10.         brr(i, j + 1) = Mid(arr(i, 2), j, 1)
  11.     Next
  12. Next
  13. Sheet2.Activate
  14. Range("a2").Resize(UBound(brr), 6) = brr
  15. End Sub
复制代码
回复

使用道具 举报

发表于 2014-4-8 21:46 | 显示全部楼层
………………

分解1.zip

7.23 KB, 下载次数: 10

回复

使用道具 举报

 楼主| 发表于 2014-4-8 22:34 | 显示全部楼层
dsmch 发表于 2014-4-8 21:46

老师好...

C1=345. 点 按钮,,,程序没反应...

不知道是什么原因
回复

使用道具 举报

发表于 2014-4-8 22:42 | 显示全部楼层    本楼为最佳答案   
Sub Macro1()
Dim arr, brr, i&, j%
arr = Range("a1:b" & Range("a65536").End(xlUp).Row)
x = [c1]
ReDim brr(1 To UBound(arr), 1 To 6)
For i = 1 To UBound(arr)
    brr(i, 1) = arr(i, 1)
    brr(i, 6) = arr(i, 2)
    For j = 1 To Len(x)
        brr(i, j + 1) = Mid(arr(i, 2), Mid(x, j, 1), 1)
    Next
Next
Sheet2.Activate
Range("a2").Resize(UBound(brr), 6) = brr
End Sub
回复

使用道具 举报

 楼主| 发表于 2014-4-8 23:01 | 显示全部楼层
dsmch 发表于 2014-4-8 22:42
Sub Macro1()
Dim arr, brr, i&, j%
arr = Range("a1:b" & Range("a65536").End(xlUp).Row)

dsmch老师好...

执行代码..程序..没有把结果写入 数据 这表格里,而是写在 开奖 这表格 里 了
回复

使用道具 举报

 楼主| 发表于 2014-4-8 23:09 | 显示全部楼层
原来是我 开了 其它表格 的缘故
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 00:57 , Processed in 0.540050 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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