excel文本提取求助！

不辣之姜

mikezhan 发表于 2018-8-5 18:25
Sub test()
Dim arr1, arr2, brr

非常感谢您的回复！

不辣之姜

mikezhan 发表于 2018-8-5 18:25
Sub test()
Dim arr1, arr2, brr

您的这段代码运行出来是姓名不是标题，但已经很棒了我仔细借鉴一下 受教了！

鄂龙蒙

1. Sub 提取()
   
2.     Dim arr, brr, d, i, k
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("A1:B5")
   
5.     ReDim brr(1 To UBound(arr), 1 To 2)
   
6.     For i = 1 To UBound(arr)
   
7.         d(arr(i, 1)) = ""
   
8.     Next
   
9.     For i = 1 To UBound(arr)
   
10.         For Each k In d.keys
    
11.             If arr(i, 2) Like "*" & k & "*" Then
    
12.                 brr(i, 1) = k
    
13.                 brr(i, 2) = Split(arr(i, 2), k)(1)
    
14.             End If
    
15.         Next
    
16.     Next
    
17.     [C1].Resize(UBound(brr), 2) = brr
    
18. End Sub

复制代码

duquancai

神马意思？？？手机上网中。

小饼干910326

不知道是不是楼主需要的结果，希望对你有帮助
这个更加简单

zopey

=tq(B2,-1.1,"[\s|+|-]([一-龥]{2,3})[\s|+|-].+\.doc$")

提取姓名.zip (11.71 KB, 下载次数: 1)

2018-8-6 10:56 上传

点击文件名下载附件

YZC51

学习16楼老师代码
Sub 模糊匹配出姓名1()
Dim i, ro, y, k, ii, yy
ro = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To ro
        For y = 1 To ro
      
            If InStr(Cells(i, 2), Cells(y, 1)) Then
                k = k + 1
                Cells(k, 3) = Mid(Cells(i, 2), InStr(Cells(i, 2), Cells(y, 1)) + Len(Cells(y, 1)))
            Else
                ii = 0
            End If
        Next y
    Next i
End Sub

小饼干910326

Sub 模糊匹配出姓名1()
Dim i, ro, y
ro = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To ro
        For y = 1 To ro
            If InStr(Cells(i, 2), Cells(y, 1)) Then Cells(i, 3) = Cells(y, 1)
        Next y
    Next i
End Sub

这个会简单一些些

duquancai

1. Sub main()
   
2.     Dim s1$, s$, js As Object, j$, arr, r&, i&, brr()
   
3.     r = Range("a:b").Find("*", , , , 1, 2).Row: arr = Range("a1:b" & r)
   
4.     For i = 1 To UBound(arr): s1 = s1 & "," & arr(i, 1): s = s & "," & "'" & arr(i, 2) & "'": Next
   
5.     Set js = CreateObject("MSScriptControl.ScriptControl")
   
6.     js.Language = "JavaScript"
   
7.     j = "o={};'" & s1 & "'.replace(/[^,]+/g,function(s){o[s]=0});"
   
8.     j = j & "function fu(o,a){b=[];for(k in o)for(i=0;i<a.length;i++)if(a[i].indexOf(k)!=-1)b.push(a[i].split(k)[1]);return b};"
   
9.     j = j & "b=fu(o," & "[" & Mid(s, 2) & "]" & ");": r = js.eval(j & "b.length")
   
10.     ReDim brr(1 To r, 1 To 1)
    
11.     For i = 0 To r - 1: brr(i + 1, 1) = js.eval("b[" & i & "]"): Next
    
12.     Range("c1").Resize(r) = brr
    
13. End Sub

复制代码