是否可以更好地编写此 VBA 代码？

Question

我在这里重新发明轮子吗？有一个更好的方法吗？此 VBA 函数在 Access 中的表单的注释字段中查找字符串的第一个实例，该字符串包含 20 个或更少字符，没有空格，用 (~) 波浪线括起来，然后返回它。

Public Function ParseComment(strComment As String) As String

'  This function parses the comment field of the job entry dialog for (~) tilde 
'  surrounded text, then returns that text.

Dim intCounter As Integer
Dim intFirstChar As Integer
Dim intLastChar As Integer
Dim strResult As String

intFirstChar = 0
intLastChar = 0
intCounter = 0

Do While (intLastChar = 0) And (intCounter < Len(strComment))
    intCounter = intCounter + 1

    strCharacter = Mid(strComment, intCounter, 1)

    If (strCharacter = "~") Then
        If intFirstChar Then
            intLastChar = intCounter
        Else
            intFirstChar = intCounter + 1
        End If
    End If

Loop

strResult = Mid(strComment, intFirstChar, intLastChar - intFirstChar)

If (intLastChar - intFirstChar <= 20) And (intFirstChar <> 0 Or intLastChar <> 0) And Not InStr(strResult, " ") Then
    ParseComment = strResult
End If

End Function

非常感谢。

Answer 1

我会使用InStr 来查找~ 字符的第一次和第二次出现，类似这样，而不是手动循环：

Public Function ParseComment(strComment As String) As String

'  This function parses the comment field of the job entry dialog for (~) tilde
'  surrounded text, then returns that text.

Dim firstTilde As Integer
Dim secondTilde As Integer
Dim strResult As String

firstTilde = 0
secondTilde = 0
strResult = ""

firstTilde = InStr(strComment, "~")

If firstTilde > 0 Then

    secondTilde = InStr(firstTilde + 1, strComment, "~")

    If (secondTilde > 0) And (secondTilde < 20) Then

        strResult = Mid(strComment, firstTilde, secondTilde)

        If InStr(strResult, " ") = 0 Then

            ParseComment = strResult
        End If
    End If
End If

End Function

[免责声明，我没有测试过这个！]

Answer 2

使用内置函数可能会快一点，但不要想象它会产生重大影响...

类似：

Public Function getTildeDelimStringPart(inputstring As String) As String

Dim commentStart As Long, commentEnd As Long

commentStart = InStr(1, inputstring, "~")

If commentStart = 0 Then ' no tilde
    getTildeDelimStringPart = vbNullString
    Exit Function
End If

commentEnd = InStr(1 + commentStart, inputstring, "~")
If commentEnd = 0 Then
    getTildeDelimStringPart = vbNullString
    Exit Function
End If

getTildeDelimStringPart = Mid(inputstring, commentStart, commentEnd - commentStart + 1)

End Function

Answer 3

我看到每个人都给了你更多的方法来做到这一点（instr 是一个很好的方法，请参阅 Vicky 的回答！），所以我将列出一些优化代码的技巧：

• 使用 Long 而不是 Integer。 VBA 每次都会将它们转换为 Long。
• 在 VBA 中 Int 和 Long 的默认值是 0，所以不需要这样声明。
• 使用 Mid$ 而不是 Mid
• 使用 Instr() 将是查找 ~ 位置的一种非常有效的方法

有趣的提示：如果您确实想评估每个字符，最快的方法是数字比较：

if Asc(Mid$(strComment, intCounter, 1)) = 126 Then

Answer 4

这对我有用：

Public Function ParseComment(strComment As String) As String

Dim regex As Object ' VBScript_RegExp_55.RegExp
Dim regexmatch As Object ' VBScript_RegExp_55.MatchCollection
Set regex = CreateObject("VBScript_RegExp_55.RegExp")

With regex
  .MultiLine = False
  .Global = False
  .IgnoreCase = True
  .Pattern = "(~[^ ~]{1,20}~)"
End With

Set regexmatch = regex.Execute(strComment)

If regexmatch.Count > 0 Then
  ParseComment = regexmatch(0)
End If

End Function

如果要删除波浪号，可以在末尾添加额外的解析。

我在以下字符串上对其进行了测试：

ABC~123aA%dwdD~CBA

函数返回~123aA%dwdD~

忘记提及此代码需要位于 %windir%\system32\vbscript.dll\3 中的 VBScript 正则表达式 5.5，尽管该代码是后期绑定的，因此您应该可以将其放入您的项目中。