logo标签列表

如何在VBA Excel宏中进行正则表达式搜索和替换？

regexexcelvba
4

我想创建一个VBA宏，用正则表达式将工作表中的所有单元格替换为时间格式的文本字符串：

(1[0-2]|[1-9]):[0-5][0-9]:[0-5][0-9] [AP]M

使用单元格地址和工作表名称。我认为调用类似于：

 Cells.Replace What:="1:23:45 AM",    
    Replacement:="=cell(""filename"")&cell(""Address"")", _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
    False, ReplaceFormat:=False

但我希望我可以将“What:=”参数设置为正则表达式，或者至少限制在时间格式上。

我该如何做到这一点？

测试数据：请以CSV格式保存以下内容：

00:00,04:27,00:36,04:31,00:00
00:00,00:00,04:18,01:07,10:06
00:00,00:00,00:00,00:00,00:00

最终，该宏将删除所有零次，并用经过评估的公式静态文本替换其他时间=cell("filename")&"!"&cell("address")

对上述输入文件进行操作的结果（我将保存工作表为XLSX）：

     [    A    ]   [     B     ]  [     C     ]  [     D     ]  [     E     ]
[1]                'Sheet1!$B$1   'Sheet1!$C$1   'Sheet1!$D$1
[2]                               'Sheet1!$C$2   'Sheet1!$D$2   'Sheet1!$E$2
[3]
< p > < em >为了简洁起见，我省略了=cell("filename")函数返回的目录和文件名，尽管上面的内容是我真正想要的。

我仍然不清楚你在这里想要做什么 - 你能提供一个之前和之后的样本吗？ - brettdj
3个回答
5
我已经更新了我的代码，原先托管在这里，更新后的代码可以实现以下两个功能：
  1. 移除用户选择范围内的任何文本字段，这些字段的值为'00:00
  2. 将任何“时间字段”替换为完整路径
（注：实际数据格式下，对于0.0到1.0之间的值，单元格测试即可，因此正则表达式有点过度） before after 
    '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 KillTime  


    Sub KillTime()
    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 strSht As String
    Dim X()

    On Error Resume Next
    Set rng1 = Application.InputBox("Select range for the replacement of leading zeros", "User select", Selection.Address, , , , , 8)
    If rng1 Is Nothing Then Exit Sub
    On Error GoTo 0

    strSht = ActiveWorkbook.Path & "\[" & ActiveWorkbook.Name & "]" & rng1.Parent.Name
    'remove '00:00
    rng1.Replace "00:00", vbNullString, xlWhole

    'See Patrick Matthews excellent article on using Regular Expressions with VBA
    Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "^0\.\d+$"    
     '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
                   If objReg.test(X(lngRow, lngCol)) Then X(lngRow, lngCol) = strSht & rngArea.Cells(1).Offset(lngRow - 1, lngCol - 1).Address(0, 0)
                Next lngCol
            Next lngRow
            'Dump the updated array back over the initial range
            rngArea.Value2 = X
        Else
            'caters for a single cell range area. No variant array required
               If objReg.test(rngArea.Value) Then rngArea.Value = strSht & rngArea.Address(0, 0)            
        End If
    Next rngArea

    'cleanup the Application settings
    With Application
        .ScreenUpdating = True
        .Calculation = lngCalc
        .EnableEvents = True
    End With

    Set objReg = Nothing
    End Sub
我已经尝试过了，这是我的发现：较大的范围会很好地变成空白，但没有替换。单个单元格范围始终具有替换值，无论它们是否应该包含null。尝试多个单元格范围时，代码永远不会在“如果objReg.test ...”条件的“Then”子句上中断。我阅读了Patrick的文章，但没有足够的VBA勇气弄清楚它在哪里不同步。我甚至用一个特定单元格的剪切和粘贴替换了regEx表达式，但多范围操作没有捕捉到它。有什么想法吗？ - Jamie
代码在测试数据上的表现完全符合广告。嗯，也许 csv 文件中的文本（例如：0:00,4:27,0:36,4:31,0:00）在我打开它时（Excel 2007）被转换成了我的语言环境？当我查看一个单元格的内容，其中包含 csv 文本 0:00 时，我在公式框中看到的是 12:00:00 AM，同样地，对于一个包含 csv 文本 4:27 的单元格，我在公式框中看到的是 4:27:00 AM。有了这些信息，我尝试将正则表达式更改为：objReg.Pattern = "^([1?[0-9]|2[0-3]):[0-5][0-9]:[0-5][0-9] [AP]M"，但没有成功。 - Jamie
我应该补充说明，当我说单元格被“清空”（变为空/置为NULL）时，只有应该这样做的单元格才会这样 - 也就是包含“00:00”的单元格。但实际上，在您提供的rng1.Replace正下方，我不得不添加第二行：rng1.Replace "12:00:00 AM", vbNullString, xlWhole，尽管原始csv数据格式为0:00。这就是我认为转换到我的区域设置可能会发生的原因。 - Jamie
1
这让我更接近了很多。还有一些特殊情况，但在我能更好地量化它们之前，我会先说声谢谢。 - Jamie
@Jamie 没问题，我很乐意帮助你在这里或新问题中进一步整理。很高兴看到你已经接近完成了。 - brettdj
显示剩余3条评论
5

既然您想要替换格式，我建议您基于格式进行替换。使用正则表达式可能会强制涉及底层数字。

我在 XL 2003 和 2010 中进行了测试：

Sub ReplaceByFormat()
With ActiveSheet.Cells
    .Replace What:="", Replacement:="=cell(""filename"")&cell(""Address"")", _
             SearchFormat:=True, _
             ReplaceFormat:=False, _
             LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    Application.FindFormat.NumberFormat = "h:mm AM/PM"
End With
End Sub

编辑

首先，我在上面犯了一个错误，将FindFormat放在最后。它需要放在开头(Doh)。

替换函数没有OR参数。因此，在下面，我只是重复了第二种格式的代码。

此代码假定日期都是常数。如果它们是公式，则可以使用VBA中的查找和替换修复。如果它们是混合的，则需要扩展代码：

Sub ReplaceByFormat()

With ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
    Application.FindFormat.NumberFormat = "h:mm AM/PM"
    .Replace What:="", Replacement:="=cell(""filename"")&cell(""Address"")", _
             SearchFormat:=True, _
             ReplaceFormat:=False, _
             LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    Application.FindFormat.NumberFormat = "m/d/yyyy"
    .Replace What:="", Replacement:="=cell(""filename"")&cell(""Address"")", _
             SearchFormat:=True, _
             ReplaceFormat:=False, _
             LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
End With
End Sub
我无法让它正常工作...有没有办法在查找部分使用“或”条件？我似乎在同一张表上有几种不同的日期格式，并且空白日期字段也被替换了。 - Jamie
日期是常数、公式还是混合形式？ - Doug Glancy
常量 - 但数据以CSV格式打开，因此根据字符串，Excel会将它们转换...不过，我会试试你的新答案。 - Jamie
好的，现在我明白了。它不是数字格式，而是字符串。现在清楚了，这就是你的意思。 - Doug Glancy
谢谢您的回复，您向我展示了一种新的结构(With ... End With)，这对未来的 VBA 开发将是有价值的。 - Jamie
0

首先，一个更好的模式是：

  /[0-2]?[0-9]:[0-5][0-9]:[0-5][0-9] [A|P]M/

其次，没有任何与您的问题相关的具体内容的实际代码将非常简单（当然需要根据您的情况进行调整）：
Set RegExp= CreateObject("VBScript.RegExp")
RegExp.Pattern = "[0-2]?[0-9]:[0-5][0-9]:[0-5][0-9] [A|P]M"
For i = ......
  Expr = Format(ActiveSheet.Cells(i, 1).Value, ActiveSheet.Cells(i, 1).NumberFormat)
  If RegExp.Test(Expr) Then Replace....
Next i

这样VBA将按它们的外观处理单元格中的值。

编辑

关于模式还可以匹配“29:00:00 |M”的问题-我不确定为什么“|”被认为是有效字符，因为它表示“或”。如果使用“，”也会发生同样的情况。无论如何，更好的选择肯定是：

/^(([0-1]?[0-9])|(2[0-4])):[0-5][0-9]:[0-5][0-9] [A|P]M$/
  • 仅允许0-24小时
  • "^"和"$"确保单元格中只包含时间格式值，表示字符串的开头和结尾

但最终，如果RegExp模式匹配的仅是时间值，这并不重要，因为输入数据的格式化将使用Excel完成，它将预先验证单元格内容（如果您键入“29:00:00”，它将转换为第二天上午5点）。这是一个Excel解决方案，可能只能导致Excel解决方案，而不是全局解决方案。

在这种意义上，在Excel中甚至不常用正则表达式 - RegExp是一个字符串测试器，没有语义意义评估，对于这种情况下的输入验证，您有其他手段。例如，您可以使用纯VBA完成相同的操作：

Function IsTime(rng As Range) As Boolean
  Dim sValue As String
  sValue = rng.Cells(1).Text
  On Error Resume Next
  IsTime = IsDate(TimeValue(sValue))
  On Error GoTo 0
End Function
'Source: http://excel.tips.net/T003292_Checking_for_Time_Input.html
不确定为什么您觉得有必要更改正则表达式（并且在答案被接受3年后），它是为我的区域设置进行调整的：匹配的搜索结果现在包含了一个更大的数据集。 - Jamie
1
你的正则表达式匹配了 29:00:00 |M。 - Toto
@Jamie 如果我碰巧看到了这个帖子，其他人也可能会看到，所以发表回复仍然是有效的。 - Bernardo Dal Corno
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接