有沒有辦法在Excel中創建一個文本清理宏，可以刪除短語后的某個短語和一定數量的字符？

Question

我正在Excel中創建一個新的流程，它與多個電子表格相關聯。 我目前的一個問題是將注釋移植到新的電子表格中。 問題出現在存儲數據的系統中。每當有人在系統中編輯注釋時，它就會生成一個Unique LineRefNo。 這會產生一個問題，因為我將擁有一個包含20行數據的地址。 每行都有相同的音符，但幾個獨特的LineRefNo分散在各處。 這使得無法在聚合級別上移植干凈的音符。

我嘗試了一些基本代碼和不同的變體只是為了刪除當前的LineRefNum。 然而，我已經過度使用該代碼。

' This Macro is to remove excess information from the Comment Field
 ActiveWorkbook.ActiveSheet.Range("A1").Select

ActiveWorkbook.ActiveSheet.Cells.Replace What:="{[LineRefNum", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

我有兩個問題。 一個是我開始使用的基本代碼是刪除幾乎每個單元格中的所有數據。 我只想刪除LineRefNo並保留實際音符。

第二個問題是我需要刪除LineRefNo以及此短語后面的16個字符。 （{[LineRefNum：532351517A000010]）。

最終結果只是隨后的實際評論。 {[LineRefNum: 532354632A000010][Comment: Cleared and approved on PV 2.13.19 File ][User: \\*****][Date: Feb 27 2019 11:08AM]}

如果我可以讓它工作，我會編輯和擴展宏以在文本上執行更多清理功能。

謝謝你的幫助。 如果這在VBA目前是不可能的，請告訴我，我將不再浪費時間。

Answer 1

編輯 ：已實現您仍然可以使用Range.Replace方法一次性完成此操作，因為您的匹配條件非常簡單：

Sub tgr()

    ActiveWorkbook.ActiveSheet.Cells.Replace "[LineRefNum*]", vbNullString

End Sub

（原帖，留給后人和任何有興趣學習正則表達式的人）以下是如何使用正則表達式完成此操作的示例：

Sub tgr()

    Dim ws As Worksheet
    Dim rData As Range
    Dim oRegEx As Object
    Dim oMatches As Object
    Dim vMatch As Variant
    Dim aData As Variant
    Dim sCommentsCol As String
    Dim sPattern As String
    Dim lHeaderRow As Long
    Dim i As Long

    Set ws = ActiveWorkbook.ActiveSheet
    sPattern = "\[LineRefNum:\s[(a-z|A-Z|0-9)]+\]"
    sCommentsCol = "A"
    lHeaderRow = 1  'If you don't have a header row, set this to 0

    Set oRegEx = CreateObject("VBScript.RegExp")
    With oRegEx
        .MultiLine = True
        .Global = True
        .IgnoreCase = True
        .Pattern = sPattern
    End With

    With ws.Range(ws.Cells(lHeaderRow + 1, sCommentsCol), ws.Cells(ws.Rows.Count, sCommentsCol).End(xlUp))
        If .Row <= lHeaderRow Then Exit Sub 'No data
        Set rData = .Cells
        If .Cells.Count = 1 Then
            ReDim aData(1 To 1, 1 To 1)
            aData(1, 1) = .Value
        Else
            aData = .Value
        End If
    End With

    For i = 1 To UBound(aData, 1)
        Set oMatches = oRegEx.Execute(aData(i, 1))
        If oMatches.Count > 0 Then
            For Each vMatch In oMatches
                aData(i, 1) = Replace(aData(i, 1), vMatch, vbNullString)
            Next vMatch
        End If
    Next i

    rData.Value = aData

End Sub

Answer 2

這樣做了你想要的測試，總是可以使用更多的信息，但似乎你知道這個文本編輯需要在哪個列：

Option Explicit

Public Sub parserLineRef()

Dim lastrow As Long
Dim startrow As Long
Dim searchcol As Long ' col number definition
Dim i As Long 'loop iterator
Dim newstring As String 'the newly modified string
Dim oldstring As String 'the original string
Dim retPos As Long 'the position of the substring in the serached string, zero is not found

Dim ws As Worksheet

'Change this to suit your needs
searchcol = 1
startrow = 1

'Change this to suit your needs
Set ws = ThisWorkbook.Worksheets("Sheet1") 'I simply copied into a new workbook default name is Sheet1

'get the last row
lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

For i = startrow To lastrow

    'convert cell contents to string, just in case
    oldstring = CStr(ws.Cells(i, searchcol))

    'Find the position of the string in the cell
    'zero means  your search string is not found
    retPos = InStr(oldstring, "[LineRefNum")

    If retPos > 0 Then
        'the substring was found, make a new string taking the LineRefNum off
        newstring = Mid(oldstring, retPos + 30, Len(oldstring) - (retPos + 30))
        'put the new string back into the cell
        ws.Cells(i, searchcol) = newstring
    Else
        'Do Nothing, move along to the next row
    End If

Next i

End Sub

給它一個旋轉，看看它是否符合你的需求。

快樂的編碼！ - WWC