Есть ли способ создать макрос очистки текста в Excel, который может удалить определенную фразу и количество символов после фразы?

Question

Я создаю новый процесс в Excel, который связывает несколько таблиц.Одна из моих текущих проблем заключается в переносе заметок на новую электронную таблицу.Проблема возникает с системой, в которой хранятся данные. Каждый раз, когда кто-то редактирует заметку в системе, он генерирует уникальный 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

Это сделало то, что вы хотели в тестировании, всегда могло использовать больше информации, но, кажется, вы знаете, в каком столбце должен находиться этот текстовый редактор:

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

Answer 2

РЕДАКТИРОВАТЬ : понял, что вы все еще можете использовать метод 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