在Excel-VBA中使用RegEx替换文本

I have data in Excel like follows (one row here - one cell in Excel):

我在Excel中有数据如下（这里有一行 - Excel中的一个单元格）：

07 July 2015 12:02 – 14 July 2015 17:02
12 August 2015 22:02 – 01 September 2015 11:02

I want to write a macro that will delete all time info (e.g. "12:02") within a user's selection (multiple cells) to look like this:

我想编写一个宏，它将删除用户选择（多个单元格）中的所有时间信息（例如“12:02”），如下所示：

07 July 2015 – 14 July 2015
12 August 2015 – 01 September 2015

When all "times" where similar ("00:00") this macro worked perfectly:

当所有“时间”相似（“00:00”）这个宏完美地工作时：

Sub delete_time()     
    Selection.Replace What:="00:00", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

End Sub

But then time-info stopped being uniform, so I decided to use RegEx. The problem is I can't find a proper way to do this on VBA. I tried this macro:

但随后时间信息不再统一，所以我决定使用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

But it didn't work. Also tried "[0-9]{2}:[0-9]{2}" and "[0-9][0-9]:[0-9][0-9]" patterns but nothing changed. So the problem must be in my misunderstanding of VBA (I'm new to it).

但它没有用。还试过“[0-9] {2}：[0-9] {2}”和“[0-9] [0-9]：[0-9] [0-9]”模式，但没有改变。所以问题一定是我对VBA的误解（我是新手）。

Can anyone help?

有人可以帮忙吗？

3 个解决方案

#1

The problem is with your selection.

问题出在您的选择上。

ActiveDocument.Range = _
RegEx.Replace(ActiveDocument.Range, "")

ActiveDocument doesn't exist in the Excel namespace. We have ActiveWorkbook or ThisWorkbook, but what you need now is the Selection.

Excel命名空间中不存在ActiveDocument。我们有ActiveWorkbook或ThisWorkbook，但您现在需要的是选择。

Use a for each loop to iterate all the cells in the current selection like this:

使用for for each循环迭代当前选择中的所有单元格，如下所示：

Dim myCell As Range

For Each myCell In Selection.Cells
  myCell.Value = RegEx.Replace(myCell.Value, "")
Next

#2

A faster approach would be to combine your RegExp with a variant array:

更快的方法是将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

#3

The easiest approach to me seems to be to use LEFT and RIGHT functions to extract the two separate timestamps, then to convert these timestamps to dates using TEXT function. Probably easiest in excel directly, but if you want to go down VBA route then example solution below:

对我来说最简单的方法似乎是使用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")

#1