Sub fenlie() Dim dict1 As Object Set dict1 = CreateObject("scripting.dictionary") maxr1 = Range("d65536").End(xlUp).Row arr1 = Range("a1:a" & maxr1) For Each i In arr1 dict1(i) = Split(i, " ") Next arr2 = dict1.Keys() arr3 = dict1.Items() For J = LBound(arr3) To UBound(arr3) m = 1 For Each K In arr3(J) Cells(J + 1, 4 + m) = K m = m + 1 Next Next End Sub Sub test() Dim rng As Range, arr, a As Range Set rng = Application.InputBox("请选择需要拆分的单元格区域", "单元格的处理", , , , , , 8) For Each a In rng str1 = rng.Text str1 = Replace(str1, " ", " ") arr = Split(str1, " ") ii = UBound(arr) + 1 For i = 1 To ii If i Mod 2 = 0 Then 'rng.Offset(0, i) = arr(i - 1) rng.Offset(0, i + 1) = arr(i - 1) End If Next i Next a End Sub
原文地址:http://www.cnblogs.com/xkdn/p/16899148.html
1. 本站所有资源来源于用户上传和网络,如有侵权请邮件联系站长!
2. 分享目的仅供大家学习和交流,请务用于商业用途!
3. 如果你也有好源码或者教程,可以到用户中心发布,分享有积分奖励和额外收入!
4. 本站提供的源码、模板、插件等等其他资源,都不包含技术服务请大家谅解!
5. 如有链接无法下载、失效或广告,请联系管理员处理!
6. 本站资源售价只是赞助,收取费用仅维持本站的日常运营所需!
7. 如遇到加密压缩包,默认解压密码为"gltf",如遇到无法解压的请联系管理员!
8. 因为资源和程序源码均为可复制品,所以不支持任何理由的退款兑现,请斟酌后支付下载
声明:如果标题没有注明"已测试"或者"测试可用"等字样的资源源码均未经过站长测试.特别注意没有标注的源码不保证任何可用性