在单元格内提取姓名

lyh5500

huanglicheng 发表于 2017-12-5 12:52
SoSo工具集中的拆分行工具能很方便的解决这个问题

我打开之后，是空的，连空白文档都没有，能告诉我一下怎么用你的模板吗》谢谢

lyh5500

huanglicheng 发表于 2017-12-5 12:52
SoSo工具集中的拆分行工具能很方便的解决这个问题

soso工具集哪里能下载？怎么安装到EXCEL中去？

melville

这样也可以实现

Kaohsing

lyh5500 发表于 2017-12-5 13:20
我打开之后，是空的，连空白文档都没有，能告诉我一下怎么用你的模板吗》谢谢

这样试试 姓名提取.rar (15.3 KB, 下载次数: 33)

2017-12-5 15:29 上传

点击文件名下载附件

szqhb

前面的几种方法都可以，收藏了

szqhb

Chip_Kenny 发表于 2017-12-5 12:23
try this:

貌似最后两行代码多余

佛山小老鼠

1. Option Explicit
   
2. Sub 拆分()
   
3.     Dim x, arr1, z, arr2, arr3(1 To 10000, 1 To 1), y, k
   
4.     x = Cells(Rows.Count, 1).End(xlUp).Row '获取A列最后一个非空单元格的行号
   
5.     arr1 = Range("A1:A" & x) '把A列的数据装入数组中
   
6.     For y = 1 To UBound(arr1) '循环数组arr1的行
   
7.         arr2 = Split(arr1(y, 1), " ") '按空格拆分，把拆分的数据装入arr2
   
8.         For z = 0 To UBound(arr2) '循环数组arr2
   
9.             k = k + 1
   
10.             '把数据从数组arr2中转让给arr3,进行存储，因为arr2是动态的
    
11.             arr3(k, 1) = arr2(z)
    
12.         Next z
    
13.     Next y
    
14.     '把数组arr3读出来，放在B列
    
15.     [B1].Resize(k, 1) = arr3
    
16. End Sub
    

复制代码

790698478

到此学习一次

everbest2015

Sub test()
    Dim ar, br(), rr, i&, k&, m&, x, s
    ar = Sheet1.Range("a1").CurrentRegion
    For i = 1 To UBound(ar)
        s = RTrim(LTrim(ar(i, 1)))
        rr = Split(s, "  ")
        k = k + UBound(rr) + 1
        ReDim Preserve br(1 To 1, 1 To k)
        For Each x In rr
            If x <> "" Then
                m = m + 1
                br(1, m) = x
            End If
        Next
    Next
    Sheet2.Range("a:a").ClearContents
    Sheet2.[a1].Resize(k) = Application.Transpose(br)
End Sub

sdc3211772

Sub test()
    Dim arr, ar, i%, j%, n%, brr()
    arr = Sheets("sheet1").Range("a1", Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp))
    For i = 1 To UBound(arr)
        ar = Split(arr(i, 1))
        For j = 0 To UBound(ar)
            If ar(j) <> "" Then
                n = n + 1
                ReDim Preserve brr(1 To n)
                brr(n) = ar(j)
            End If
        Next
    Next
    Sheets("sheet2").Cells(1, 2).Resize(n) = Application.Transpose(brr)
End Sub