求助VBA字符串提取

Curry_Chen

CC:提取字符串
提取D列描述中制定字符串，从第一个字符开始查找，直至查找到"RRU"或"pRRU"或"pRU"开始截取，直到第一个逗号结束，
例如：D1单元格截取内容RRU3168e-fa(DC)
D9单元格截取内容RRU3158-fa
D10单元格截取内容pRRU01
D11单元格截取内容pRU01

截取内容放至H列

liulang0808

Sub 按钮4_Click()
    Application.ScreenUpdating = False
    crr = Array("pRRU", "RRU", "pRU")
    [h1] = "结果"
    arr = ActiveSheet.UsedRange
    For j = 2 To UBound(arr)
        If Len(arr(j, 4)) > 0 Then
            brr = Split(arr(j, 4), ",")
            For i = 0 To UBound(brr)
                For k = 0 To UBound(crr)
                    If InStr(brr(i), crr(k)) > 0 Then
                        arr(j, 8) = Mid(brr(i), InStr(brr(i), crr(k)))
                        GoTo l1
                    End If
                Next k
            Next i
l1:
        End If
    Next j
    ActiveSheet.UsedRange = arr
    Application.ScreenUpdating = True
End Sub

liulang0808

根据楼主的描述做了处理，不过楼主的条件有冲突，还有感觉结果提取，有些字符满足描述，貌似不是需求的结果
供参考

Curry_Chen

liulang0808 发表于 2018-8-7 19:28
根据楼主的描述做了处理，不过楼主的条件有冲突，还有感觉结果提取，有些字符满足描述，貌似不是需求的结果 ...

忘了加一个条件，每个单元格只提取第一个符合条件的，后面就忽略了

liulang0808

Curry_Chen 发表于 2018-8-7 20:15
忘了加一个条件，每个单元格只提取第一个符合条件的，后面就忽略了

是提取第一个满足条件的

Curry_Chen

liulang0808 发表于 2018-8-7 20:16
是提取第一个满足条件的

是有点问题的，是我总结的规律不全，能再加个条件，RRU、pRRU、pRU后面是数字，就直接提取，不是数字继续查找

gbgbxgb

详情见附件。

liulang0808

Curry_Chen 发表于 2018-8-7 20:22
是有点问题的，是我总结的规律不全，能再加个条件，RRU、pRRU、pRU后面是数字，就直接提取，不是数字继续 ...

Sub 按钮4_Click()
    Application.ScreenUpdating = False
    crr = Array("pRRU", "RRU", "pRU")
    [h1] = "结果"
    arr = ActiveSheet.UsedRange
    For j = 2 To UBound(arr)
        If Len(arr(j, 4)) > 0 Then
            brr = Split(arr(j, 4), ",")
            For i = 0 To UBound(brr)
                For k = 0 To UBound(crr)
                    If InStr(brr(i), crr(k)) > 0 Then
                        If Split(brr(i), crr(k))(1) Like "*[1-9]*" Then
                            arr(j, 8) = Mid(brr(i), InStr(brr(i), crr(k)))
                            GoTo l1
                        End If
                    End If
                Next k
            Next i
l1:
        End If
    Next j
    ActiveSheet.UsedRange = arr
    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容供参考。。。。。。

Curry_Chen

谢谢老师！！