有没有办法在Excel中创建一个文本清理宏，可以删除短语后的某个短语和一定数量的字符？

Question

I'm creating a new process in Excel that ties in several spreadsheets. One of my current problems is in porting notes over to the new spreadsheet. The issue arises with the system that the data is stored in. Every time someone edits a note in the system it generates a Unique LineRefNo. This creates an issue as I will have an address that has 20 lines of data. Each line has the same note but several unique LineRefNo scattered throughout. This makes it impossible to port over clean notes on an aggregate level.

I've tried some base code and different variations just to remove the current LineRefNum currently. I have been overdeleting with that code however.

' 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

I've got two issues. One is the base code I've started with is deleting all data from almost every cell. I just want it to remove the LineRefNo and leave the actual note.

The second issue is I need it to delete the LineRefNo plus the 16 characters following this phrase. ({[LineRefNum: 532351517A000010]).

The end result would be just the actual comment that follows. {[LineRefNum: 532354632A000010][Comment: Cleared and approved on PV 2.13.19 File ][User: \\*****][Date: Feb 27 2019 11:08AM]}

If I can get that to work I would edit and expand upon the Macro to do more cleanup functions on the text.

Thanks for any help. If this is impossible in VBA currently just let me know and I will stop wasting my time.

Answer 1

EDIT : Realized you can still use the Range.Replace method to do this in one fell swoop since your match condition is pretty simple:

Sub tgr()

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

End Sub

(Original post, leaving for posterity and anybody interested in learning regex) Here's an example of how to accomplish this using a regular expression:

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

This did what you wanted in testing, could always use more information but it seems you know what column this text edit needs to take place in:

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

Give it a spin and see if it meets your needs.

Happy Coding! - WWC