在VBA中调用自定义RegEx函数

von4xj4u  于 2022-12-19  发布在  其他
关注(0)|答案(2)|浏览(220)

我想清理我的excel文件,它使用了this这样的正则表达式查询。不幸的是,通过数据验证和CTRL-F3“托管名称”提到的方法确实与VBA中的Worksheet_Change() sub冲突。这意味着当对有问题的单元格应用数据验证时,Worksheet_Change()在某种程度上被忽略了。
无论如何,没有太多的VBA定期由长镜头。我有一个模块与函数RegExpMatch如下(从上面的网站,我希望这个函数甚至可以用于此目的):

Public Function RegExpMatch(input_range As Range, pattern As String, Optional match_case As Boolean = True) As Variant
...

当使用这个作为公式(iidoe.=RegExpMatch(Sheet1!A1, "^[A-Z]{3}-\d{3}$"))时,它工作得很好。但是由于上述冲突,我想这样称呼它:

Private Sub Worksheet_Change(...)
....
    If RegExpMatch(<target>, <pattern>) Then
        ...
    End If
End Sub

我以前遇到过一些特殊字符的问题,我发现这通常很混乱。不确定模式是否有问题,也不确定我是如何尝试调用RegExpMatch的,但不知何故,我需要它来工作,它给了我一个运行时错误424。我理解,有一个有点build-in RegEx possibility (see Tools->References),但是这个文件需要在不同的机器上分发,因此我不想让它依赖于特殊的或过时的设置。
编辑:请参见下面的MWE。目标是在单元格值与RegEx匹配时保存文件。在上一个代码示例中,在If循环中调用RegExpMatch-Function时发生错误。我有一个名为RegExpMatch的模块,如下所示:

Public Function RegExpMatch(input_range As Range, pattern As String, Optional match_case As Boolean = True) As Variant
  Dim arRes() As Variant 'array to store the results
  Dim iInputCurRow, iInputCurCol, cntInputRows, cntInputCols As Long 'index of the current row in the source range, index of the current column in the source range, count of rows, count of columns

  On Error GoTo ErrHandl

  RegExpMatch = arRes

  Set regex = CreateObject("VBScript.RegExp")
  regex.pattern = pattern
  regex.Global = True
  regex.MultiLine = True
  If True = match_case Then
    regex.ignorecase = False
  Else
    regex.ignorecase = True
  End If

  cntInputRows = input_range.Rows.Count
  cntInputCols = input_range.Columns.Count
  ReDim arRes(1 To cntInputRows, 1 To cntInputCols)

  For iInputCurRow = 1 To cntInputRows
    For iInputCurCol = 1 To cntInputCols
      arRes(iInputCurRow, iInputCurCol) = regex.Test(input_range.Cells(iInputCurRow, iInputCurCol).Value)
    Next
  Next

  RegExpMatch = arRes
  Exit Function
  ErrHandl:
    RegExpMatch = CVErr(xlErrValue)
End Function

我尝试在我的工作表代码中使用它,如下所示:

Public Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("J3")) Is Nothing Then
  ' The following shows run-time error 424
    If RegExpMatch(Range("J3"), "^[A-Z]{3}-\d{3}$") Then
      ActiveWorkbook.SaveAs Filename:=Range("J3").value
    End If
  End If
End Sub
3z6pesqy

3z6pesqy1#

这不是一个答案(关于解释错误),但正如@FunThomas指出的,我使用的是内置的VBScript.RegEx,所以我写了一个更简单的自定义函数RegExpMatch,它可以根据需要工作。

Public Function RegExpMatch(ByVal value as String, ByVal pattern As String)
  Set regex = CreateObject("VBScript.RegExp")
  regex.pattern = pattern
  RegExpMatch = regex.Test(value)
End Function

在我的Workbook_Change sub中调用如下:

...
  Dim value As String
  value = Target.value
  Dim pattern As String
  pattern = "^[A-Z]{3}-\d{3}$"
  If RegExpMatch(value, pattern) Then
    ...
  End If
...
tquggr8v

tquggr8v2#

尝试删除该行

RegExpMatch = arRes

就在

On Error Goto ErrHandl

此时数组仍然未定义,这很可能导致错误。

相关问题