[英]Replace text using RegEx in Excel-VBA
我在 Excel 中有如下数据(此处一行 - Excel 中的一个单元格):
07 July 2015 12:02 – 14 July 2015 17:02
12 August 2015 22:02 – 01 September 2015 11:02
我想编写一个宏来删除用户选择(多个单元格)中的所有时间信息(例如“12:02”),如下所示:
07 July 2015 – 14 July 2015
12 August 2015 – 01 September 2015
当所有“时间”相似(“00:00”)时,此宏完美运行:
Sub delete_time()
Selection.Replace What:="00:00", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
但后来时间信息不再统一,所以我决定使用 RegEx。 问题是我找不到在 VBA 上执行此操作的正确方法。我尝试了这个宏:
Sub delete_time()
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
On Error Resume Next
RegEx.Global = True
RegEx.Pattern = "\d\d\:\d\d"
ActiveDocument.Range = _
RegEx.Replace(ActiveDocument.Range, "")
End Sub
但它没有用。 还尝试了“[0-9]{2}:[0-9]{2}”和“[0-9][0-9]:[0-9][0-9]”模式,但没有任何改变。 所以问题肯定出在我对VBA(我是新手)的误解上。
谁能帮忙?
问题在于您的选择。
ActiveDocument.Range = _
RegEx.Replace(ActiveDocument.Range, "")
Excel命名空间中不存在ActiveDocument。 我们有ActiveWorkbook或ThisWorkbook,但您现在需要的是选择。
使用a for each循环迭代当前选择中的所有单元格,如下所示:
Dim myCell As Range
For Each myCell In Selection.Cells
myCell.Value = RegEx.Replace(myCell.Value, "")
Next
更快的方法是将RegExp
与变量数组合并:
'Press Alt + F11 to open the Visual Basic Editor (VBE)
'From the Menu, choose Insert-Module.
'Paste the code into the right-hand code window.
'Press Alt + F11 to close the VBE
'In Xl2003 Goto Tools … Macro … Macros and double-click KillDate
Sub KillDate()
Dim rng1 As Range
Dim rngArea As Range
Dim lngRow As Long
Dim lngCol As Long
Dim lngCalc As Long
Dim objReg As Object
Dim X()
On Error Resume Next
Set rng1 = Application.InputBox("Select range for the replacement", "User select", Selection.Address, , , , , 8)
If rng1 Is Nothing Then Exit Sub
On Error GoTo 0
'See Patrick Matthews excellent article on using Regular Expressions with VBA
Set objReg = CreateObject("vbscript.regexp")
objReg.Pattern = "\d\d\:\d\d"
objReg.Global = True
'Speed up the code by turning off screenupdating and setting calculation to manual
'Disable any code events that may occur when writing to cells
With Application
lngCalc = .Calculation
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
'Test each area in the user selected range
'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on
For Each rngArea In rng1.Areas
'The most common outcome is used for the True outcome to optimise code speed
If rngArea.Cells.Count > 1 Then
'If there is more than once cell then set the variant array to the dimensions of the range area
'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks
X = rngArea.Value2
For lngRow = 1 To rngArea.Rows.Count
For lngCol = 1 To rngArea.Columns.Count
'replace the leading zeroes
X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), vbNullString)
Next lngCol
Next lngRow
'Dump the updated array sans leading zeroes back over the initial range
rngArea.Value2 = X
Else
'caters for a single cell range area. No variant array required
rngArea.Value = objReg.Replace(rngArea.Value, vbNullString)
End If
Next rngArea
'cleanup the Application settings
With Application
.ScreenUpdating = True
.Calculation = lngCalc
.EnableEvents = True
End With
Set objReg = Nothing
End Sub
对我来说最简单的方法似乎是使用LEFT
和RIGHT
函数来提取两个单独的时间戳,然后使用TEXT
函数将这些时间戳转换为日期。 在excel中可能最简单,但是如果你想沿着VBA路线走,那么下面的示例解决方案:
' Taking a random date from Cell A1
DateRange = Range("A1")
' Extracting the first timestamp
FirstTimeStamp = Left(DateRange, Application.Find(" – ", DateRange))
' Converting to required date format
FirstDate = Application.Text(FirstTimeStamp, "dd-mmm-yyyy")
LastTimeStamp = Right(DateRange, Application.Find(" – ", DateRange))
LastDate = Application.Text(LastTimeStamp, "dd-mmm-yyyy")
Function ReplaceRegEx(str As String, pattern As String, newChar As String) As String 'recherche et remplace une expression reguliere par une chaine de char
Dim regEx As Object, found As Object, counter As Integer, F As Object
Set regEx = CreateObject("VBscript.RegExp")
regEx.Global = True
regEx.ignorecase = False
regEx.pattern = pattern
Set found = regEx.Execute(str)
counter = found.Count
If counter <> 0 Then
For Each F In found
str = Replace(str, F, newChar)
Next F
End If
ReplaceRegEx = str
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.