提取含有“*车间”的字符

454585737

求VBA代码：A列单元格是“XX*车间”或“XX”，想在B列提取XX后面有“*车间”这三个字符，如果后面没有“*车间”，就为空。*为一，二，三，四……等数字。

182197315

没有附件呢，怎么测试

454585737

182197315 发表于 2018-4-19 20:54
没有附件呢，怎么测试

上传了，请帮忙！

jiminyanyan

Sub 例1()
    'jimin   qq494585639
    Dim reg As Object
    Set reg = CreateObject("vbscript.regexp")
    Dim sr, x
    Sheet1.Activate
    Range("b1:b10000").ClearContents
    For x = 1 To Range("a65536").End(xlUp).Row
        sr = Cells(x, 1)
        With reg
            .Global = True
            .IgnoreCase = True
            .Pattern = "(.*)(?=.车间)"
            For Each Item In .Execute(sr)
                If Len(Item) Then
                    Cells(x, 2) = Item
                End If
            Next
        End With
    Next x
    Sheet1.Activate
End Sub

jiminyanyan

。。。。。。。。

454585737

jiminyanyan 发表于 2018-4-19 21:05
Sub 例1()
    'jimin   qq494585639
    Dim reg As Object

谢谢！我是要提取后面的几车间字符出来。前面的不要

jiminyanyan

454585737 发表于 2018-4-19 21:08
谢谢！我是要提取后面的几车间字符出来。前面的不要

Sub jimin()
    'jimin   qq494585639
    Dim reg As Object
    Set reg = CreateObject("vbscript.regexp")
    Dim sr, x
    Sheet1.Activate
    Range("b1:b10000").ClearContents
    For x = 1 To Range("a65536").End(xlUp).Row
        sr = Cells(x, 1)
        With reg
            .Global = True
            .IgnoreCase = True
            .Pattern = ".车间"
            For Each Item In .Execute(sr)
                If Len(Item) Then
                    Cells(x, 2) = Item
                End If
            Next
        End With
    Next x
    Sheet1.Activate
End Sub

454585737

jiminyanyan 发表于 2018-4-19 21:12
Sub jimin()
    'jimin   qq494585639
    Dim reg As Object

谢谢！好快啊

ggmmlol

B2输入以下公式：
=IF(RIGHT(A1,2)="车间",RIGHT(A1,3),"")

lsc900707

1. Sub gj23w98()
   
2.     r = Cells(Rows.Count, 1).End(3).Row
   
3.     arr = Range("a1:b" & r)
   
4.     For i = 1 To UBound(arr)
   
5.         If InStr(arr(i, 1), "车间") > 0 Then
   
6.             arr(i, 2) = Right(arr(i, 1), 3)
   
7.         End If
   
8.     Next
   
9.     Range("a1:b" & r) = arr
   
10. End Sub
    

复制代码