[已解决]字母、数字等字符提取

YUANXMJYPX

各位老师  大神们  下午好！
       我在工作中经常遇到“数字、字母、空格及其他符号（/）” 等混合在一起并放在一个单元格里，分别代表不同的含义，要现在，要求利用函数或VBA提取出来分别放在两个单元格里。请各位大师帮忙解决，谢谢在线支持！具体要求详见“数据分离附件".

最佳答案

月排行榜 / 总排行榜

qh8600

2015-6-24 10:32

数据分离.rar (10.05 KB, 下载次数: 10)

2015-6-24 10:32 上传

点击文件名下载附件
这样

跳转到最佳答案楼层

qh8600

1. Function demo(rng As Range, x As Integer) As String
   
2.     Dim a, ar, i, m(1 To 2)
   
3.     a = rng.Value
   
4.     ar = Split(a, " ")
   
5.     For i = 0 To UBound(ar)
   
6.         If ar(i) <> "" Then
   
7.             If InStr(ar(i), "/") Then
   
8.                 If InStr(m(1), Split(ar(i), "/")(0)) = 0 Then m(1) = m(1) & Split(ar(i), "/")(0) & ";"
   
9.                 If InStr(m(2), Split(ar(i), "/")(1)) = 0 Then m(2) = m(2) & Split(ar(i), "/")(1) & "、"
   
10.             Else
    
11.                 If InStr(m(1), ar(i)) = 0 Then m(1) = m(1) & ar(i) & ";"
    
12.                 m(2) = "空值 "
    
13.             End If
    
14.         End If
    
15.     Next
    
16.     If x = 1 Or x = 2 Then demo = Left(m(x), Len(m(x)) - 1)
    
17. End Function

复制代码

写了个自定义的，附件楼下

qh8600

数据分离.rar (8.28 KB, 下载次数: 12)

2015-6-23 16:09 上传

点击文件名下载附件
楼主试试

易安1

1. Private Sub 运行_Click()
   
2. Set d1 = CreateObject("scripting.dictionary")
   
3. Set d2 = CreateObject("scripting.dictionary")
   
4. arr = [a1].CurrentRegion
   
5. Dim crr(1 To 100000, 1 To 2)
   
6. On Error Resume Next
   
7. For i = 2 To UBound(arr)
   
8.     brr = Split(arr(i, 1), " ")
   
9.     For j = 0 To UBound(brr)
   
10.         T0 = Split(brr(j), "/")(0)
    
11.         T1 = Split(brr(j), "/")(1)
    
12.         d1(T0) = "": d2(T1) = ""
    
13.     Next
    
14.     k = k + 1
    
15.     crr(k, 1) = Join(d1.keys, ":")
    
16.     crr(k, 2) = Join(d2.keys, "、")
    
17.     [e2].Resize(k, 2) = crr
    
18.     d1.RemoveAll: d2.RemoveAll
    
19. Next
    
20. End Sub

复制代码

双字典提取吧

易安1

附件参考

qh8600

数据分离.rar (10.05 KB, 下载次数: 10)

2015-6-24 10:32 上传

点击文件名下载附件
这样

YUANXMJYPX

qh8600 发表于 2015-6-24 10:32
这样

       qh8600   老师  你好！   你于2015年06月帮我写的代码：数据分离小程序，我一直在用，但现在数据源有变化，该代码就不能使用了，还请你完善一下，谢谢！请详见附件。