Можно ли написать этот код 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

Я вижу, что каждый дал вам еще несколько способов сделать это ( instr - отличный способ, посмотрите ответ Вики!), Поэтому я просто перечислю несколько советов по оптимизации вашего кода:

• Используйте Long вместо Integer. VBA будет конвертировать их в Long каждый раз.
• Значение по умолчанию для Int и Long равно 0 в VBA, поэтому нет необходимости объявлять их так.
• Используйте Mid $ вместо Mid
• Использование Instr () было бы очень эффективным способом найти местоположение ~

Забавный совет: если вы хотите оценить каждый символ, самый быстрый способ - сравнение чисел:

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

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 Regular Expressions 5.5, который находится в% windir% \ system32 \ vbscript.dll \ 3, хотя код имеет позднюю привязку, поэтому вы можете просто добавить его в свой проект. 1016 *

Answer 4

Использование встроенных функций может быть немного быстрее, но не думайте, что это будет иметь решающее значение ...

Что-то вроде:

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