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

编辑：意识到您仍然可以使用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

有没有一种方法可以在Excel中创建一个文本清除宏，该宏可以删除某些短语以及该短语之后的一些字符？

2 个答案: