给定一个字符串，我想提取一些文本答案

【问题标题】：Given a string I want to extract some text给定一个字符串，我想提取一些文本
【发布时间】：2019-08-27 21:02:21
【问题描述】：

给定一个字符串列表，我想将字符串分成不同的列。字符串并不总是采用相同的格式，所以我不能每次都使用相同的方法。我试图将 LC-XXXXXX 放在 B 列中，然后删除“s”并将文本放在“s”之后和“^”或“。”之间。（无论字符串包含什么）到 C 列

我正在为每个保存为数组的字符串运行一个“for循环”，看起来像这样：

我使用了 split、trim 和 mid 命令，但没有成功。

With Sheets("TELECOM")
.Range("A14", "I305").ClearContents
For Each objFile In objFolder.Files
On Error Resume Next
    If InStr(objFile.Name, "LC-9") > 0 And InStr(objFile.Type, "DWG File") > 0 Then
        drwn = objFile.Name
        .Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the drawing number and placing it here
        values = Array(drwn)
        Set re = CreateObject("vbscript.regexp")
        pattern = "(s\d+)"
    For i = LBound(values) To UBound(values)
        .Cells(r, 3) = Replace$(drwn, "s", vbNullString)
    Next
    r = r + 1
    End With

    Public Function GetId(ByVal re As Object, ByVal s As String, ByVal pattern As String) As String
With re
    .Global = True
    .MultiLine = True
    .IgnoreCase = False '? True if case insensitive
    .pattern = pattern
    If .test(s) Then
        GetId = .Execute(s)(0).SubMatches(0)
    End If
End With

结束函数

我想获取 stings 列表并将 LC-XXXXX 放在 B 列和工作表编号（“s”和“^”之间的数字，有时是“.dwg”或“.pdf”）进入C列

新编辑 04/06/2019

新编辑 04/07/2019

主要代码子GetIssued() 将 objFSO 调暗为对象将 objFolder 调暗为对象将 objFile 作为对象调暗

Dim openPos As Integer
Dim closePos As Integer

Dim sh As Object

Dim drwn, SheetNum

Set objFSO = CreateObject("scripting.FileSystemObject")

r = 14


fle = ThisWorkbook.Sheets("Header Info").Range("D11") &  
"\Design\Substation\CADD\Working\COMM\"

Set objFolder = objFSO.GetFolder(fle)

Set x1Book = ActiveWorkbook 'Using this Activeworkbook
Set sh = x1Book.Sheets("TELECOM") 'Using this particular sheet
With Sheets("TELECOM")
.Range("A14", "I305").ClearContents
For Each objFile In objFolder.Files
On Error Resume Next

If InStr(objFile.Name, "LC-9") > 0 And InStr(objFile.Type, "DWG                 
File") > 0 Then 'PEDs, Single Line, Cable and Wiring, Jumper and     
Interconnection
        .Cells(r, 9) = objFile.Name 'Testing Purposes
        drwn = Array(.Cells(r, 9).Value)
        .Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the 
drawing number and placing it here

        '-----------------------------------------------------------
        'Trying to Insert InstrMacro here
        '------------------------------------------------------------

        r = r + 1

        ElseIf InStr(objFile.Name, "MC-9") > 0 And InStr(objFile.Type, "DWG File") > 0 Then 'Cable List
        .Cells(r, 9) = objFile.Name 'Testing Purposes
        drwn = .Cells(r, 9).Value
        .Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the drawing number and placing it here 

        '-----------------------------------------------------------
        'Trying to Insert InstrMacro here
        '------------------------------------------------------------

        r = r + 1

        ElseIf InStr(objFile.Name, "BMC-") > 0 And InStr(objFile.Type, "Adobe Acrobat Document") > 0 Then 'Bill of Materials
        .Cells(r, 9) = objFile.Name 'Testing Purposes
        drwn = .Cells(r, 9).Value
        .Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the drawing number and placing it here 

        '-----------------------------------------------------------
        'Trying to Insert InstrMacro here
        '------------------------------------------------------------

        r = r + 1

        ElseIf InStr(objFile.Name, "CSR") > 0 And InStr(objFile.Type, "DWG") > 0 Then 'Single Line Diagram
        .Cells(r, 9) = objFile.Name 'Testing Purposes
        drwn = .Cells(r, 9).Value
        .Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the drawing number and placing it here

        '---------------------------------------------------------
        'Trying to Insert InstrMacro here
        '------------------------------------------------------------

        r = r + 1
    End If
Next
End With





 Range("A13:F305").HorizontalAlignment = xlCenter
 Range("A1").Select

 End Sub

我工作的 marco 可以在这里看到：

Sub InstrMacro()

Dim openPos As Integer
Dim closePos As Integer

Dim drwn, SheetNum
drwn = Range("E9") ' String to search in the sheet aka: the hot seat


'Performing a test to see if this is a new drawing or not
SheetNum = InStr(drwn, "^")

openPos = InStr(drwn, "s") 'True reguardless of the condition of the drawing

If SheetNum = 0 Then 'Assuming it is a new drawing
closePos = InStr(drwn, ".")
SheetNum = Mid(drwn, openPos + 1, closePos - openPos - 1)
Else

If SheetNum > 0 Then 'Assuming is NOT a new drawing
closePos = InStr(drwn, "^")
SheetNum = Mid(drwn, openPos + 1, closePos - openPos - 1)

End If
End If

Range("G20").Value = SheetNum


End Sub

可以在此处查看此宏的图片。

我已经尝试制作一个单独的宏运行并且可以获得工作表编号，但似乎 excel 只是跳过这一步并运行程序的其余部分

我想把图纸编号放在B栏，把图纸编号放在c栏的图纸编号中。

【问题讨论】：

s 可以出现在字符串的其他位置吗？如果有，后面会跟一个数字吗？当你说只是 s2 你实际上是指 s 后跟任何数字吗？这个数字总是一个数字吗？
不确定您是指一种模式，还是在字符串中的某处找到s2。如果这是您想要的，请尝试Instr(1,MyFileName,"s2",vbTextCompare)，它将返回一个整数值，其中包含匹配搜索值的起始位置。基本上，如果返回大于 0，则包含在较大的字符串中。
@RyanWildry 不，我只需要 s 和“^”或“。”之间的数字。无论字符串包含哪个。

标签： excel vba

【解决方案1】：

没有循环也没有正则表达式的解决方案

Sub FindIt()
    Dim strng As String, iPos As Long

    strng= "1sa2sb3s4sd5se"

    iPos = InStr(strng, "s")
    If iPos > 0 And iPos < Len(strng) Then
        If InStr("1234567890", Mid(strng, iPos + 1, 1)) > 0 Then
            MsgBox "Found s" & Mid(strng, iPos + 1,1) & " at position " & iPos
        End If
    End If
End Sub

这可以很容易地限制“s”字符后面的数字位数

【讨论】：

【解决方案2】：

如果 s 后跟一个数字，并且这种模式只出现一次，则可以使用正则表达式。

Option Explicit
Public Sub test()
    Dim re As Object, pattern As String, values(), i As Long
    values = Array("LC-94773s2^003735377.pdf", "LC-94773s2", "LC-93521s1-A^005241446")
    Set re = CreateObject("vbscript.regexp")
    pattern = "(s\d+)"
    For i = LBound(values) To UBound(values)
        Debug.Print Replace$(GetId(re, values(i), pattern), "s",vbNullString)
    Next
End Sub

Public Function GetId(ByVal re As Object, ByVal s As String, ByVal pattern As String) As String
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = False '? True if case insensitive
        .pattern = pattern
        If .test(s) Then
            GetId = .Execute(s)(0).SubMatches(0)
        Else
            GetId = "No match"
        End If
    End With
End Function

你可以改变这个模式，例如，如果想开始是LC-9

Public Sub test()
    Dim re As Object, pattern As String, values(), i As Long
    values = Array("LC-94773s2^003735377.pdf", "LC-94773s2", "LC-93521s1-A^005241446")
    Set re = CreateObject("vbscript.regexp")
    pattern = "LC-9(.*)(s\d+)"
    For i = LBound(values) To UBound(values)
        Debug.Print Replace$(GetId(re, values(i), pattern), "s",vbNullString)
    Next
End Sub

【讨论】：

使用第一个代码，这会一直返回带有“s”的工作表编号有没有办法删除并获取“s”之后的文本？
见编辑回答。我也会在某个时候更新正则表达式，因为也可以删除那里的 s。
几乎明白了...我知道这不包括在我的原始问题中，但是如果我有一个以 MC-XXXXXXsTCV4 开头的字符串，我可以让这个也返回 TCV4 吗？ @QHarr
模式和所需的返回字符串是什么？当然不只是 TCV4，还有 TCV4、TCV5 或类似的模式，并且以 MC 开头-
它与 LC-XXXXX 相同。我希望最终结果看起来像我在问题中发布的新图片。（我无法将其上传到此评论，因此我将其发布在那里。）

【解决方案3】：

查看字符串是否包含小写s后跟数字：

Sub sTest()
    Dim s As String, i As Long
    s = "jkuirelkjs6kbco82yhgjbc"

    For i = 0 To 9
        If InStr(s, "s" & CStr(i)) > 0 Then
            MsgBox "I found s" & i & " at position " & InStr(s, "s" & CStr(i))
            Exit Sub
        End If
    Next i

    MsgBox "pattern not found"
End Sub

【讨论】：

【解决方案4】：

你可以试试：

Option Explicit

Sub test()

    Dim arr As Variant
    Dim i As Long

    arr = Array("LC-94773s2^003735377.pdf", "LC-94773s2", "Mar", "LC-93521s1-A^005241446")

    For i = LBound(arr) To UBound(arr)
        If InStr(1, arr(i), "s") Then
            Debug.Print Mid(arr(i), InStr(1, arr(i), "s"), 2)
        End If
    Next i

End Sub

【讨论】：