Question

给出一个字符串列表，我想将字符串分成不同的列。字符串并不总是采用相同的格式，因此我不能每次都使用相同的方法。我试图将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

结束功能

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

NEW EDIT 04/06/2019

新编辑2019年4月7日

主要代码子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列中将图纸编号输入图纸编号。

Answer 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”字符后的数字位数

Answer 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

Answer 3

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

lpCmdLine

Answer 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

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

4 个答案: