[已解决]想向大神们请教一下提取字串的方法

Akakpk

想向大神们请教一下提取字串的方法，我想用VBA码，将A列以下AWPX字串后的数字提取到H列，A的资料还会向下增加。
当中会用到IFERROR，MID，FIND
请帮忙修改一下，万分感谢

Dim sht As Worksheet

Dim k As Long

Set sht = ThisWorkbook.Worksheets("sheet1")

k = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

Set Rng = Range(Cells(1, 1), Cells(k, 1))

Set Rng2 = Range(Cells(1, 8), Cells(k, 8))

Rng2.Formula = "=IFERROR(MID(Rng,Find(""AWPX"",Rng)+7,2)"0")"

最佳答案

月排行榜 / 总排行榜

苏子龙

2017-8-20 11:01

1. Sub tt()
   
2.     Dim reg, i&, arr, brr
   
3.     arr = Sheets("工作表1").Range("a1", Range("a65536").End(3))
   
4.     ReDim brr(1 To UBound(arr))
   
5.     Set reg = CreateObject("VBScript.RegExp")
   
6.     reg.Global = True
   
7.     reg.IgnoreCase = True
   
8.     reg.Pattern = "awpx.+?(\d+)"
   
9.      For i = 1 To UBound(arr)
   
10.             If reg.Test(arr(i, 1)) Then
    
11.                    brr(i) = reg.Execute(arr(i, 1))(0).SubMatches(0)
    
12.             Else
    
13.                 brr(i) = "no"
    
14.             End If
    
15.         Next
    
16.     Sheets("工作表1").Range("d1").Resize(UBound(brr)) = Application.Transpose(brr)
    
17. End Sub

复制代码

跳转到最佳答案楼层

苏子龙

1. Sub tt()
   
2.     Dim reg, i&, arr, brr
   
3.     arr = Sheets("工作表1").Range("a1", Range("a65536").End(3))
   
4.     ReDim brr(1 To UBound(arr))
   
5.     Set reg = CreateObject("VBScript.RegExp")
   
6.     reg.Global = True
   
7.     reg.IgnoreCase = True
   
8.     reg.Pattern = "awpx.+?(\d+)"
   
9.      For i = 1 To UBound(arr)
   
10.             If reg.Test(arr(i, 1)) Then
    
11.                    brr(i) = reg.Execute(arr(i, 1))(0).SubMatches(0)
    
12.             Else
    
13.                 brr(i) = "no"
    
14.             End If
    
15.         Next
    
16.     Sheets("工作表1").Range("d1").Resize(UBound(brr)) = Application.Transpose(brr)
    
17. End Sub

复制代码

Akakpk

太强了，全都是我不懂的语句