Excel精英培训网

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

[已解决]关于重新分组问题

[复制链接]
发表于 2015-2-1 16:29 | 显示全部楼层 |阅读模式
本帖最后由 yvll 于 2015-2-1 21:21 编辑

请教关于重新分组问题,谢谢!
关于分组问题.rar (10.96 KB, 下载次数: 14)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2015-2-1 17:59 | 显示全部楼层    本楼为最佳答案   
  1. Sub Macro1()
  2. Dim arr, i&, j%, k%, zf$, p$
  3. arr = [x2:ad4]
  4. For i = 1 To UBound(arr)
  5.     For j = 1 To UBound(arr, 2)
  6.         zf = Replace(arr(i, j), " ", "")
  7.         p = ""
  8.         For k = 1 To Len(zf) - 2 Step 3
  9.             p = p & " " & Mid(zf, k, 3)
  10.         Next
  11.         arr(i, j) = Mid(p, 2)
  12.     Next
  13. Next
  14. Range("bo2").Resize(UBound(arr), UBound(arr, 2)) = arr
  15. End Sub
复制代码
回复

使用道具 举报

发表于 2015-2-1 18:03 | 显示全部楼层
  1. Sub test()
  2.     Dim arr, tm$, i&, j&, k&, sr$
  3.     arr = Range("X2:AD4").Value
  4.     For i = 1 To UBound(arr)
  5.         For j = 1 To UBound(arr, 2)
  6.             tm = Replace(arr(i, j), " ", "")
  7.             sr = ""
  8.             For k = 1 To (Len(tm) \ 3) * 3 Step 3
  9.                 sr = sr & " " & Mid(tm, k, 3)
  10.             Next
  11.             arr(i, j) = Mid(sr, 2)
  12.         Next
  13.     Next
  14.     Range("BO2").Resize(UBound(arr), UBound(arr, 2)) = arr
  15. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2015-2-1 21:20 | 显示全部楼层
dsmch 发表于 2015-2-1 17:59

谢谢您,非常好。
回复

使用道具 举报

 楼主| 发表于 2015-2-1 21:20 | 显示全部楼层
xdragon 发表于 2015-2-1 18:03

谢谢您,非常好。
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 14:30 , Processed in 0.296415 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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