提取指定内容到各单元格

quqiyuan

代码如下。。。
Sub test()
    brr = Range("a2:a" & Cells(Rows.Count, 1).End(3).Row)
    crr = Application.Transpose([c1:e1])
    ReDim drr(1 To UBound(brr), 1 To UBound(crr))
    For i = 1 To UBound(brr)
        s = brr(i, 1)
        For j = 1 To UBound(crr)
            If InStr(brr(i, 1), crr(j, 1)) Then
                drr(i, j) = Split(Split(s, crr(j, 1))(1), "，")(0)
            Else
                drr(i, j) = 0
            End If
        Next
    Next
    [C1].CurrentRegion.Offset(1).ClearContents
    [c2].Resize(UBound(drr), UBound(drr, 2)) = drr
    Beep
End Sub

ykcbf1100

字典+正则提取数据

1. Sub ykcbf()  '//2024.7.19
   
2.     Set reg = CreateObject("VBScript.Regexp")
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With reg
   
5.         .Global = True
   
6.         .IgnoreCase = True
   
7.         .Pattern = "([一-龢]+)(\d+)"
   
8.     End With
   
9.     r = Cells(Rows.Count, 1).End(3).Row
   
10.     For i = 2 To r
    
11.         st = Cells(i, 1)
    
12.         c = 2
    
13.         Set mh = reg.Execute(st)
    
14.         For Each k In mh
    
15.             s = k.submatches(0) & i
    
16.             d(s) = Val(k.submatches(1))
    
17.         Next
    
18.         For j = 3 To 5
    
19.             Cells(i, j) = d(Cells(1, j) & i)
    
20.         Next
    
21.     Next
    
22.     MsgBox "OK！"
    
23. End Sub
    

复制代码

niko88819

C2 公式右拉及下拉

1. =GetCountryCode(C$1,$A2)

复制代码

1. Function GetCountryCode(inputRange As Range, countryRange As Range) As String
   
2.     Dim cell As Range
   
3.     Dim regex As Object
   
4.     Set regex = CreateObject("VBScript.RegExp")
   
5.     regex.Global = True
   
6.     For Each cell In inputRange
   
7.         With regex
   
8.             .Pattern = cell.value & "(\d+)"
   
9.             If .test(countryRange.value) Then
   
10.                 Set matches = .Execute(countryRange.value)
    
11.                 GetCountryCode = matches(0).SubMatches(0)
    
12.                 Exit Function
    
13.             End If
    
14.         End With
    
15.     Next cell
    
16.     GetCountryCode = ""
    
17. End Function
    

复制代码

niko88819

今天早上刚想到，用公式也可以解决

1. =IFERROR（MID（$A2，SEARCH（C$1，$A2）+LEN（C$1），2），0）+0

复制代码

saghj