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

这对我有用：

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~

忘了提这个代码需要VBScript正则表达式5.5，它位于％windir％\ system32 \ vbscript.dll \ 3中，虽然代码是后期绑定的，所以你应该只能将它放到你的项目中。 / p>

Answer 4

我看到每个人都给了你更多的方法（ instr 是一个好方法，请参阅Vicky的回答！），所以我只列出一些优化代码的技巧：< / p>

使用Long而不是Integer。 VBA每次都会将它们转换为Long。
在VBA中，Int和Long的默认值为0，因此无需声明它们。
使用Mid $代替Mid
使用Instr（）将是一种非常有效的方法来查找〜

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

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

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

4 个答案: