截取字符串

ljxvba

例：

中国电信股份有限公司服务费
中国电信股份有限公司保证金
中国电信股份有限公司江苏分公司运输费

要求：把公司名称后面的字符全部去掉，只保留公司名字。
规律是字符串中最后一个司后面的字符全部清除，想法是string.replace(”司*“，”司“）,
但这样会把”江苏分公司“也去掉，求大神指点！

小花鹿

instrrev.....................................................................................................................

zax010

Sub zz()
    For i = 1 To [a65536].End(3).Row
        s = Cells(i, 1)
        For a = Len(s) To 2 Step -1
            If Mid(s, a, 1) = "司" And Mid(s, a - 1, 1) = "公" Then
                Cells(i, 2) = Mid(s, 1, a)
                Exit For
            End If
        Next
    Next
End Sub



Book1.rar (6.36 KB, 下载次数: 5)

2017-6-28 13:26 上传

点击文件名下载附件

jiminyanyan

Sub 例11()
    Dim reg As Object
    Set reg = CreateObject("vbscript.regexp")
    Dim sr, x
    Sheet11.Activate
    For x = 1 To Range("a65536").End(xlUp).Row
        sr = Cells(x, 1)
        k = 2
        With reg
            .Global = True
            .IgnoreCase = True
            .Pattern = ".*公司"
            For Each Item In .Execute(sr)
                Cells(x, k) = Item
            Next
        End With
    Next x
    Sheet11.Activate
End Sub

yayahzmeng

主体就两句；
Sub tst()
    s = Cells(x, 1)
    Cells(x, 2) = Replace(s, Mid(s, InStrRev(s, "公司") + 2), "")
End Sub

cbtaja

Sub test()
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True
    reg.Pattern = "(.*公司).*?$"
    arr = Range("A1").CurrentRegion.Resize(, 1)
    For i = 1 To UBound(arr)
        arr(i, 1) = reg.Replace(arr(i, 1), "$1")
    Next
    Range("A1").CurrentRegion.Resize(, 1).Offset(, 3) = arr
End Sub

曹银强

向高高手学习！

ljxvba

小花鹿 发表于 2017-6-28 12:51
instrrev............................................................................................ ...

直接有效，谢谢！