[英]Is there a way to create a Text Cleanup Macro in Excel that can remove a certain phrase and an amount of characters after the phrase?
我正在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目前是不可能的,请告诉我,我将不再浪费时间。
编辑 :已实现您仍然可以使用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
这样做了你想要的测试,总是可以使用更多的信息,但似乎你知道这个文本编辑需要在哪个列:
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
给它一个旋转,看看它是否符合你的需求。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.