Excel精英培训网

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

[已解决]求一VBA可以将一串文字按要求分开并放在指定单元格

[复制链接]
发表于 2017-7-7 17:03 | 显示全部楼层 |阅读模式
将选中的一个或多个单元格中的字符串(如一些人的姓名,姓名之间用全角或半角空格或顿号或逗号分隔)
分隔后的数据依次放到单元格A1、A2、A3、A4……中

111.jpg
最佳答案
2017-7-9 12:33
Sub test()
    Dim A(1 To 10000, 1 To 1), x, y, i

    With Range("d:d")
        .Replace " ", ","
        .Replace ",", ","
    End With

    For Each x In [d1:d2]
        For Each y In Split(x, ",")
            i = i + 1
            A(i, 1) = y
        Next
    Next
   
    Range("a:a").ClearContents
    [a1].Resize(i) = A
End Sub

分开.rar

5.9 KB, 下载次数: 15

发表于 2017-7-7 17:22 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2017-7-7 17:50 | 显示全部楼层
爱疯 发表于 2017-7-7 17:22
为什么从A5开始,另起一行?

个相当于对两个单元格的数据同时处理。因为第一个单元格中有四个人名,所以对第二个单元格处理时,从A5单元格开始了。

要不直接对选中的一个单元格处理, 这样容易实现吧。如选中D1,得到A1-A4。
回复

使用道具 举报

发表于 2017-7-9 12:33 | 显示全部楼层    本楼为最佳答案   
Sub test()
    Dim A(1 To 10000, 1 To 1), x, y, i

    With Range("d:d")
        .Replace " ", ","
        .Replace ",", ","
    End With

    For Each x In [d1:d2]
        For Each y In Split(x, ",")
            i = i + 1
            A(i, 1) = y
        Next
    Next
   
    Range("a:a").ClearContents
    [a1].Resize(i) = A
End Sub
回复

使用道具 举报

发表于 2017-7-9 13:10 | 显示全部楼层
  1. Sub ek_sky()
  2.    Dim ar1 As Variant, ar2 As Variant, ar3() As Variant
  3.    Dim i As Integer, j As Integer, k As Integer
  4.       ar1 = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row)
  5.             For i = 1 To UBound(ar1)
  6.                ar2 = Split(StrConv(Replace(ar1(i, 1), " ", ","), vbNarrow), ",")
  7.                For j = 0 To UBound(ar2)
  8.                   k = k + 1
  9.                ReDim Preserve ar3(1 To 1, 1 To k)
  10.                ar3(1, k) = ar2(j)
  11.                Next j
  12.             Next i
  13. [a:a].ClearContents
  14. Range("A1").Resize(UBound(ar3, 2)) = Application.Transpose(ar3)
  15. End Sub
复制代码
回复

使用道具 举报

发表于 2017-7-10 10:16 | 显示全部楼层
本帖最后由 大灰狼1976 于 2017-7-10 10:18 编辑

  1. Sub aaa()
  2. Dim arr, i&, s$
  3. arr = selection
  4. For i = 1 To UBound(arr)
  5.   s = s & " " & arr(i, 1)
  6. Next i
  7. arr = Split(Replace(Trim(s), ",", " "), " ")
  8. [a1].Resize(UBound(arr) + 1) = Application.Transpose(arr)
  9. End Sub
复制代码
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 23:18 , Processed in 0.637199 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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