繁体   English   中英

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

[英]How can I do a regex search and replace in a VBA excel macro?

我想创建一个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:= ”参数设为reg ex,或者至少限制为时间格式。

我该怎么做?


测试数据: 以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]

为简洁起见,我删除了 =cell("filename") 函数返回 的目录和文件名 ,尽管上面是我真正想要的。

由于您要替换格式,我会根据格式进行替换。 使用正则表达式,似乎你被迫处理底层数字。

我在XL 2​​003和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

我已经更新了我以前的代码托管在这里 ,以

  1. 删除用户选定范围内'00:00所有文本字段
  2. 用完整路径替换任何文本“时间字段”

(nb:最后,正则表达式过度,因为对于实际数据格式,0.0和1.0之间的值的单元测试就足够了)

之前后

    '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

首先,更好的模式是:

  /[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” - 我不知道为什么“|” 被认为是有效的char,因为它意味着“OR”。 如果你使用“,”也会发生同样的情况。 无论如何,一个更好的肯定是:

/^(([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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM