在Excel-VBA中使用RegExreplace文本
我有Excel中的数据如下（这里是一行 – Excel中的一个单元格）：
07 July 2015 12:02 – 14 July 2015 17:02 12 August 2015 22:02 – 01 September 2015 11:02 我想编写一个macros来删除用户select（多个单元格）中的所有时间信息（例如“12:02”），如下所示：
07 July 2015 – 14 July 2015 12 August 2015 – 01 September 2015
当所有的“次”这个macros（“00:00”）这个macros完美工作：
Sub delete_time() Selection.Replace What:="00:00", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False End Sub
但时间信息停止统一，所以我决定使用正则expression式。 问题是我找不到在VBA上做到这一点的正确方法。 我试过这个macros：
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的误解（我是新手）。
谁能帮忙？
问题在于你的select。
ActiveDocument.Range = _ RegEx.Replace(ActiveDocument.Range, "")
ActiveDocument不存在于Excel命名空间中。 我们有ActiveWorkbook或ThisWorkbook，但你现在需要的是select。
使用每个循环迭代当前select中的所有单元格，如下所示：
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函数将这些时间戳转换为date。 直接在excel中大概是最简单的，但是如果你想下去VBA路由那么下面的示例解决scheme：
' 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")