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

我在这里重塑车轮吗？有一个更好的方法吗？此VBA函数在Access中的表单的注释字段中查找字符串的第一个实例，其中包含20个字符或更少，没有空格，被（〜）代字号包围，然后将其返回。是否有可能更好地编写此VBA代码？

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

非常感谢。

来源

2011-11-04 Albion

总是可以编写代码更好，但如果这对你的作品何必呢？ – NitWit

只需要注意一点，你可以将Dim intFirstChar设为Integer = 0，它可以清理所有的初始化代码，当你声明它们时初始化它们。 – JonH

@JonH“Dim intFirstChar As Integer = 0”将在VBA中导致编译错误。VBA已经将局部整数变量初始化为零，所以即使可能，它也是毫无意义的。它在VB.NET中工作。 – JimmyPena

使用内置的功能可能会快一点，但不要想象它会产生很大的不同......

喜欢的东西：

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

来源

2011-11-04 13:16:32

这是一个很好的习惯，尽可能利用内置函数。语言，它只是稍微快一点，但大多数时候你赢了。在'instr'的情况下，它也是算法的一部分变化。 –

我会用InStr找到〜字符的第一和第二OCCURENCES，这样的事情，而不是手动循环：

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

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

来源

2011-11-04 13:19:12 Vicky

这为我工作：

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，尽管代码是延迟绑定的，所以您应该可以将其放到项目中。

来源

2011-11-04 14:01:26 JimmyPena

你的正则表达式并不遵循不允许空格（或其他呃〜）。应该是“（〜[^〜] {1,20}〜）”这将允许1到20个不是空格或〜的字符。 – aevanko

我不知道VBA可以做RegEx。谢谢JP，我会试试这个。 – Albion

绝对！试试吧，让我们知道它是否有效。 – JimmyPena

我看大家给你一些更多的方式来做到这一点（INSTR是一个伟大的方式，看看Vicky的答案！），所以我就列出了对优化代码的一些技巧：

使用Long而不是整数。 VBA每次都会将它们转换为Long。
VBA中Int和Long的缺省值为0，因此不需要声明它们。
使用中间$，而不是中期
使用INSTR（）是要找到

玩转提示的〜位置非常effecient方式：如果你要评估每一个字符，最快的方式是数字对比：

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

来源

2011-11-04 16:49:02 aevanko

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

回答

相关问题