VBA脚本工作正常，突然出现错误？

23 浏览
0 Comments

VBA脚本工作正常，突然出现错误？

我在Excel表格上有以下代码。我使用VBA来修改特定单元格的内容，以便正确格式化它们以适应我的工作。我们保留有损坏、贝位和车辆识别号码的列表。每一列都有自己特定的格式，其中有两列我已经成功地处理了。你们中的一些人可能会认出这些代码中的一些内容，因为我之前在另一个帖子中就曾提到过如何正确格式化损坏代码。这些列的顺序如下：

贝位 | 车辆识别号码 | 损坏代码

对于车辆识别号码，我们只是将字母转换为大写。简单，完成了。经过一些修改以更好地适应我的需求，损坏代码的函数运行得很完美。如果没有在这里得到的原始帮助，我是无法做到这一点的。现在问题来了，我的老板看到我已经能够处理损坏代码后，要求我让它自动格式化贝位。在我的工作中，贝位有几种可能性，但前面至少有一个字母，例如：

  1. H-5
  2. H-125
  3. HH-50
  4. 7A-70
  5. FNCE-13

我想要的是这样的：

输入未经格式化的贝位，比如7a12，将字母转换成大写，按数字进行分割，在两组之间加上一个破折号，完成。我已经实现了这一点，甚至向我的老板展示了。但是当我添加了将车辆识别号码转换为大写的代码后，我开始遇到一个错误，突出显示以下行：

Set allMatches = RE1.Execute(strSource)

RE1.test(strSource)运行得很好，但尝试获取匹配项/子匹配项现在却神秘地抛出了一个错误。我最初使用了来自这个StackOverflow问题的文本来使它正常工作。我得到的错误类似于告诉我对象未设置。我知道代码目前很混乱，我不得不中途离开（认为可能是我的函数出了问题，但事实上，直接从原始子函数运行时仍然会出现相同的错误）。

编辑：错误如下

运行时错误 '91'

对象变量或 With 块变量未设置

而且，它再次突出显示

allMatches = RE.Execute(str)

任何帮助将不胜感激。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim str As String, result As String
    Dim RE As Object
    Dim allMatches As Object
    ' 变量KeyCells包含将在更改时引发警报的单元格。
    Set KeyCells = Application.Union(Range("F3:F100"), Range("C3:C100"), Range("I3:I100"))
    Set RE = CreateObject("vbscript.regexp")
    If Not TypeName(Target.Value) = "Variant()" Then
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
            Is Nothing Then
            ' 当其中一个指定单元格已更改时显示消息。
            ' 在这里放置你的代码。
            str = ConvertString(Target)
            If (Not str = Target.Value And Not Target.Value = "") Then
                Target.Value = str
            End If
        End If
        ' 现在我们要检查贝位以进行自动格式化
        Set KeyCells = Application.Union(Range("A3:A100"), Range("D3:D100"), Range("G3:G100"))
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
            Is Nothing Then
            RE.Pattern = "([0-9]?[A-Z]{1,})\-?([0-9]{1,3})"
            RE.Global = True
            If Not Target.Value = "" And Not RE.test(Target.Value) Then
                    str = CStr(Target.Value)
                    RE.IgnoreCase = True
                    allMatches = RE.Execute(str)
                    MsgBox allMatches.Count
                    Target.Value = str
            End If
        End If
        Set KeyCells = Application.Union(Range("B3:B100"), Range("E3:E100"), Range("H3:H100"))
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
            Is Nothing Then
            RE.Pattern = "[a-z]?"
            RE.IgnoreCase = False
            If RE.test(Target.Value) Then
                Target.Value = UCase(Target.Value)
            End If
        End If
    End If
End Sub
Function FormatBay(str1 As Range) As String
    Dim result As String, strSource As String
    Dim allMatches As Object
    Dim RE1 As Object
    Set RE1 = CreateObject("vbscript.regexp")
    RE1.Pattern = "([0-9]?[A-Z]{1,})\-?([0-9]{1,3})"
    RE1.Global = True
    strSource = CStr(str1.Value)
    Set allMatches = RE1.Execute(strSource)
    result = "FF-12"
    If allMatches.Count <> 0 Then
        result = allMatches.Item(0)
    End If
    MsgBox result
    FormatBay = result
End Function
Function ConvertString(str1 As Range) As String
    Dim varStr As Variant
    Dim strSource As String, strResult As String
    Dim i As Integer
    For Each varStr In Split(Trim(str1.Value), " ")
            strSource = CStr(varStr)
        If InStr(strSource, ".") = 0 Then
            strResult = strResult & _
                Mid(strSource, 1, 2) & "." & _
                Mid(strSource, 3, 2) & "." & _
                Mid(strSource, 5, 1)
            If Len(strSource) > 5 Then
                strResult = strResult & "("
                For i = 6 To Len(strSource)
                    strResult = strResult & Mid(strSource, i, 1) & ","
                Next i
                strResult = Left(strResult, Len(strResult) - 1) & ")"
            End If
            strResult = strResult & " "
        Else
            strResult = strResult & strSource & " "
        End If
    Next
    If strResult = "" Then
        ConvertString = ""
    Else
        ConvertString = Left(strResult, Len(strResult) - 1)
    End If
End Function

编辑：以下是我让它工作的代码，我知道它可能有点冗长，但我只是在学习VBA，当我学到更好的方法时，我会编辑这篇帖子，希望能帮助其他人。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim str As String, result As String
    Dim RE As Object
    Dim allMatches As Object
    ' 变量KeyCells包含将
    ' 在更改时引发警报的单元格。
    Set KeyCells = Application.Union(Range("F3:F100"), Range("C3:C100"), Range("I3:I100"))
    Set RE = CreateObject("vbscript.regexp")
    If Not TypeName(Target.Value) = "Variant()" Then
        ' 现在我们要检查贝位以进行自动格式化
        Set KeyCells = Application.Union(Range("A3:A100"), Range("D3:D100"), Range("G3:G100"))
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
            Is Nothing Then
            RE.Pattern = "([0-9]?[A-Z]{1,})\-?([0-9]{1,3})"
            RE.Global = True
            If Not Target.Value = "" And Not RE.test(Target.Value) Then
                    str = CStr(Target.Value)
                    str = FormatBay(str)
                    Target.Value = str
            End If
        End If
        Set KeyCells = Application.Union(Range("B3:B100"), Range("E3:E100"), Range("H3:H100"))
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
            Is Nothing Then
            RE.Pattern = "[a-z]?"
            RE.IgnoreCase = False
            If RE.test(Target.Value) Then
                Target.Value = UCase(Target.Value)
            End If
        End If
        Set KeyCells = Application.Union(Range("C3:C100"), Range("F3:F100"), Range("I3:I100"))
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
            Is Nothing Then
            ' 当其中一个指定单元格已更改时显示消息。
            ' 在这里放置你的代码。
            str = ConvertString(Target)
            If (Not str = Target.Value And Not Target.Value = "") Then
                Target.Value = str
            End If
        End If
    End If
End Sub
Function FormatBay(ByVal text As String) As String
    Dim result As String, bayLetter As String, bayNumber As String
    Dim length As Integer, i As Integer
    Dim allMatches As Object
    Dim RE As Object
    Set RE = CreateObject("vbscript.regexp")
    RE.Pattern = "([0-9]?[a-z]{1,})\-?([0-9]{1,3})"
    RE.Global = True
    RE.IgnoreCase = True
    Set allMatches = RE.Execute(text)
    If Not allMatches.Count = 0 Then
        bayLocation = allMatches.Item(0).submatches.Item(0)
        bayLocation = UCase(bayLocation)
        bayNumber = allMatches.Item(0).submatches.Item(1)
        length = Len(bayNumber)
        For i = 1 To (3 - length)
            bayNumber = "0" & bayNumber
        Next
        result = bayLocation & "-" & bayNumber
    End If
    FormatBay = result
End Function
Function ConvertString(str1 As Range) As String
    Dim varStr As Variant
    Dim strSource As String, strResult As String
    Dim i As Integer
    For Each varStr In Split(Trim(str1.Value), " ")
            strSource = CStr(varStr)
        If InStr(strSource, ".") = 0 And IsNumeric(strSource) Then
            strResult = strResult & _
                Mid(strSource, 1, 2) & "." & _
                Mid(strSource, 3, 2) & "." & _
                Mid(strSource, 5, 1)
            If Len(strSource) > 5 Then
                strResult = strResult & "("
                For i = 6 To Len(strSource)
                    strResult = strResult & Mid(strSource, i, 1) & ","
                Next i
                strResult = Left(strResult, Len(strResult) - 1) & ")"
            End If
            strResult = strResult & " "
        Else
            strResult = strResult & strSource & " "
        End If
    Next
    If strResult = "" Then
        ConvertString = ""
    Else
        ConvertString = Left(strResult, Len(strResult) - 1)
    End If
End Function

0

2 答案

0 Comments

VBA脚本曾经正常工作，但突然出现错误？ 这个问题出现的原因是正则表达式的模式匹配错误。具体来说，正则表达式[a-z]?总是匹配成功。如果目标字符串Target.Value的第一个字符是小写字母，则正则表达式会将其匹配消耗掉。否则，它将在第一个字符之前匹配一个空字符串。虽然您正在测试小写字母的存在，但问号?的作用是使字母变为可选项，从而失去了测试的目的。

但我不明白为什么您需要进行这个测试。您不是要将所有字母都转换为大写吗？那么只需将字符串转换为大写，然后完成即可。或者等到转换完成后再使用UCase函数进行转换。

至于实际的转换，您的代码相当混乱，但我认为您做了很多不必要的工作。如果您单独处理像7a12这样的字符串，以下代码就足够了：

RE.Pattern = "^([0-9]?[A-Z]{1,})-?([0-9]{1,3})$"

RE.IgnoreCase = True

result = UCase(RE.Replace(source, "$1-$2"))

或者我是否遗漏了什么？

不，我只是不了解正则表达式对象的替换函数。我对VBA很新。

0
0 Comments

VBA脚本之前可以正常工作，但突然出现错误了。错误的原因是在给对象变量赋值时，应该使用"Set"关键字。在当前的代码中，除非你或其他人对代码进行了无意识的编辑并改变了对该变量的赋值方式，否则我认为它从未能够正常工作而没有引发此错误。

希望这可以帮到你！之前我删除了它，它仍然可以工作（可能是缓存的版本？），然后突然就无法工作了。我尝试将那部分重新添加进去，但没有成功。我经过一番努力，最终解决了这个问题。

0