문자 선택 및 제거

Question

사용자가 입력 한 문자열과이 문자열 다음 16자를 제거하려고합니다 ... 입력 한 문자열 만 제거하면 작동하지만, 물을 때 다음 16자를 제거하려면 작동을 멈춰야합니다. 어떤 사람이 나를 도울 수 있습니까?

파일은 다음과 같습니다

04_03 (16 자) 텍스트 04_03 (+ 16characters)

04_03 (16 자) 텍스트 04_03 (+ 16characters) 텍스트 04_03 (+ 16characters)

텍스트 04_03 (+ 16characters는)

사용자가 입력 : strSearch = 04_03

내가 문자열 04_03을 삭제하려면 이 문자열 다음 16자를 더 많이, 파일에서 어떤 문자를 독립으로.

마지막 파일은 다음과 같아야합니다

텍스트 텍스트 텍스트

텍스트

Global strSearch As String 
Global strLenght As Double 

Function RegExpReplace(ByVal WhichString As String, _ 
        ByVal pattern As String, _ 
        ByVal ReplaceWith As String, _ 
        Optional ByVal IsGlobal As Boolean = True, _ 
        Optional ByVal IsCaseSensitive As Boolean = True) As String 
'Declaring the object 
Dim objRegExp As Object 

'Initializing an Instance 
Set objRegExp = CreateObject("vbscript.regexp") 

'Setting the Properties 
objRegExp.Global = IsGlobal 
objRegExp.pattern = pattern 
objRegExp.IgnoreCase = Not IsCaseSensitive 

'Execute the Replace Method 
RegExpReplace = objRegExp.Replace(WhichString, ReplaceWith) 

End Function 

Sub findCharacter() 

strSearch = InputBox("How starts the text that you would like to remove?", "Character's Search") 
If strSearch = "" Then Exit Sub 

End Sub 

Sub RemoveCharacters() 

Dim pattern As String 
Dim str As String 
Dim u As String 

With Sheets("Sheet1") 
.Select 

Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row 

    For Lrow = 1 To Lastrow Step 1 

     str = Cells(Lrow, 1).Value 
     pattern = strSearch + " [\w \W \s] {16}" 
     Cells(Lrow, 1).Value = RegExpReplace(str, pattern, "") 

    Next Lrow 

End With 

End Sub 

Answer 1

이 당신이 시도하고있는 무슨이다

?

Option Explicit 

Sub Sample() 
    Dim ws As Worksheet 
    Dim lRow As Long, pos As Long, i As Long, n As Long 
    Dim strToRepl As String, strSearch As String 

    strSearch = InputBox("How does the text start that you would like to remove?", "Character's Search") 
    If strSearch = "" Then Exit Sub 

    '~~> Change this to the relevant sheet 
    Set ws = ThisWorkbook.Sheets("Sheet1") 

    With ws 
     lRow = .Range("A" & .Rows.Count).End(xlUp).Row 

     For i = 1 To lRow 
      pos = InStr(1, .Range("A" & i).Value, strSearch, vbTextCompare) 

      If pos > 0 Then 
       n = Len(.Range("A" & i).Value) - pos 

       If Not Len(strSearch) + 16 > n Then 
        strToRepl = Mid(.Range("A" & i).Value, pos, Len(strSearch) + 16) 
        .Range("A" & i).Value = Replace(.Range("A" & i).Value, strToRepl, "") 
       End If 
      End If 
     Next i 
    End With 
End Sub 

스크린 샷