根据特定规则测试字符串

时间:2015-08-19 03:10:36

标签: vba excel-vba excel

我正在建立一个交易系统。用户将处理2D条形码。 对于每种型号,条形码应满足特定要求。见下表。

enter image description here

基于上述情况,PRT0001的第4个字符应为2,3或4。

对于PRT0002,第4个字符应为> = 3,第12个字符应为A,第13个字符应为A,第14个字符应为B

现在,对于PRT0005来说,它更复杂。 第5个和第6个字符应该在一起,其中值应该在01-52范围内(一年中的周数)。 第13和第14个字符应该是列表中的内容。

现在,我打算在Access中设置一个表,我将所有规则与上述格式有些相似,然后在用户选择PartNum时检索规则。

我打算检索CharPos字段,将其转移到数组,这将是要检查的字符位置的基础。对CharRes字段执行相同操作以获取要比较的字符。类似的东西:

Dim arr1, arr2, myrules, j, c
myrules = rec.GetRows 'I'll retrieve the rules in Access using ADO

arr1 = Split(myrule(0, 0), ",")
arr2 = Split(myrule(1, 0), ",")

For j = Lbound(arr1) To Ubound(arr1)
    c = Mid(barcode, j, 1)
    If Not c = arr2(j) Then MsgBox "Invalid": Exit For
Next

考虑到上面的PRT0004,这没关系。但是,其他规则有点复杂。我需要采用一种评估规则的标准方法,这样我就可以生成一个可以在主子网中调用的公共函数或子例程。我以为我无法通过上述方法实现这一目标。

所以我的问题是,你们对我如何做得更好有任何建议吗? 这可能太多了,但我们只是说我只是咨询我的老朋友(社区),他们可能有更好的想法或方法。

BTW,我仅限于使用Excel作为前端(用户界面),使用Access作为后端(数据库)。

2 个答案:

答案 0 :(得分:1)

我只会存储一个正则表达式模式。然后,您可以根据零件检索模式,并使用相关模式测试条形码。

例如,您可以使用以下模式(假设我没有将其中任何一个搞砸):

strPattern1 = "^\w{3}[2-4]\w{12}$"
strPattern2 = "^\w{3}[3-9]\w{7}AAB\w{3}$"
strPattern3 = "^\w{3}[4-9]\w{7}A\w{4}$"
strPattern4 = "^CD\w{9}A\w{4}$"
strPattern5 = "^\w{3}[4-9](0[1-9]|[1-4][0-9]|5[012])\w{5}E[26][FGH]\w{5}$"

唯一棘手的部分是周数,但我认为这种模式应该有用。

\w将与[0-9a-zA-Z_]匹配,因此,如果您不想要下划线和/或小写字母,则可以将\w替换为[0-9A-Z]。< / p>

使用它:

Dim re
Set re = CreateObject("VBScript.RegExp")
re.Pattern = strPattern1     ' Depending on the type of part

If re.Test(strBarcode) Then
    ' Checks out
Else
    ' Invalid
End If

答案 1 :(得分:1)

在固定情况下,Bond是正确的。我认为他的答案与这个问题不相容。因为,确实如此,我们可以使用正则表达式。但是,对于这个问题,所有条件都存储在数据库中,用户可以添加条件和部分。所以,这不行。

因此,我认为并以另一种方式尝试。但它是纯粹的VBA代码。这是我为你尝试的:

Public Function checkString(inputString As String, length As Integer, position As String, rule As String) As String

    Dim message As String

    'Set blank to message
    message = ""

    'Check string length
    If Len(inputString) <> length Then

        Call addMessage(message, "The length must be " & length & ".")

    'Check conditions
    Else

        Dim positionList, ruleList, tempRuleList
        Dim startPos, endPos, posRange, posIndex
        Dim index, tempIndex As Integer
        Dim tempRule, flag As String
        Dim isValid As Boolean
        Dim fromRange, toRange As Integer

        'get position list
        positionList = Split(Trim(position), ",")

        'get rule list
        ruleList = getRuleList(rule, UBound(positionList))

        'Looping position list
        For index = LBound(positionList) To UBound(positionList) Step 1

            'get the rule
            tempRule = ruleList(index)

            'Condition for operator case (for example: >=3)
            If InStr(1, tempRule, "<") > 0 Or InStr(1, tempRule, "=") > 0 Or InStr(1, tempRule, ">") > 0 Then

                If InStr(1, tempRule, "<") > 0 Then
                    flag = flag & "l"
                End If

                If InStr(1, tempRule, ">") > 0 Then
                    flag = flag & "g"
                End If

                If InStr(1, tempRule, "=") > 0 Then
                    flag = flag & "e"
                End If

                'Remove operators
                tempRule = Replace(tempRule, ">", "")
                tempRule = Replace(tempRule, "<", "")
                tempRule = Replace(tempRule, "=", "")

                'check
                Select Case flag

                    Case "le":
                        If Not Mid(inputString, positionList(index), 1) <= tempRule Then
                            Call addMessage(message, "The character from position " & positionList(index) & " must be less or equal with " & tempRule & ".")
                        End If

                    Case "ge":
                        If Not Mid(inputString, positionList(index), 1) >= tempRule Then
                            Call addMessage(message, "The character from position " & positionList(index) & " must be greater or equal with " & tempRule & ".")
                        End If

                    Case "l":
                        If Not Mid(inputString, positionList(index), 1) < tempRule Then
                            Call addMessage(message, "The character from position " & positionList(index) & " must be less than " & tempRule & ".")
                        End If

                    Case "g":
                        If Not Mid(inputString, positionList(index), 1) > tempRule Then
                            Call addMessage(message, "The character from position " & positionList(index) & " must be greater than " & tempRule & ".")
                        End If

                End Select

            'Condition for range case (for example: [2-5])
            ElseIf InStr(1, tempRule, "[") > 0 Then

                'remove brakets
                tempRule = Replace(tempRule, "[", "")
                tempRule = Replace(tempRule, "]", "")

                'split by comma
                tempRuleList = Split(Trim(tempRule), "-")

                fromRange = CInt(tempRuleList(0))
                toRange = CInt(tempRuleList(1))

                If InStr(1, positionList(index), "-") > 0 Then
                    posRange = Split(Trim(positionList(index)), "-")

                    startPos = posRange(0)
                    endPos = posRange(1)
                Else
                    startPos = positionList(index)
                    endPos = positionList(index)
                End If

                For posIndex = startPos To endPos Step 1
                    posVal = posVal & Mid(inputString, posIndex, 1)
                Next posIndex

                If Not (CInt(posVal) <= fromRange And CInt(posVal) >= toRange) Then
                    Call addMessage(message, "The character from positions " & positionList(index) & " must be between " & ruleList(index) & ".")
                End If

            'Condition for set of value case (for example: {2,4,5})
            ElseIf InStr(1, tempRule, "{") > 0 Then

                If InStr(1, positionList(index), "-") > 0 Then
                    posRange = Split(Trim(positionList(index)), "-")

                    startPos = posRange(0)
                    endPos = posRange(1)
                Else
                    startPos = positionList(index)
                    endPos = positionList(index)
                End If

                'remove brakets
                tempRule = Replace(tempRule, "{", "")
                tempRule = Replace(tempRule, "}", "")

                'split by comma
                tempRuleList = Split(Trim(tempRule), ",")

                'looping positions
                For posIndex = startPos To endPos Step 1

                    'Reset isValid flag
                    isValid = False

                    'looping rule list
                    For tempIndex = LBound(tempRuleList) To UBound(tempRuleList) Step 1

                        If Mid(inputString, posIndex, 1) = tempRuleList(tempIndex) Then
                            isValid = True
                            Exit For
                        End If

                    Next tempIndex

                    If Not isValid Then
                        Call addMessage(message, "The character from position " & posIndex & " must be one of " & ruleList(index) & ".")
                    End If

                Next posIndex

            'Condition for must be one case (for example: A)
            ElseIf Mid(inputString, positionList(index), 1) <> tempRule Then

                Call addMessage(message, "The character from position " & positionList(index) & " must be " & tempRule & ".")

            End If

        Next index

    End If

    'Return message
    If message = "" Then
        checkString = "Valid"
    Else
        checkString = "The string '" & inputString & "' is not valid. Fixed the following error:" & vbNewLine & message
    End If

End Function

Private Function getRuleList(rule As String, count As Integer) As Variant

    Dim tempList, returnList
    Dim tempIndex, resultIndex As Integer

    'split by comma
    tempList = Split(Trim(rule), ",")

    'If there is no special condition, return list
    If count = UBound(tempList) Then

        returnList = tempList

    'Else process for special codition
    Else

        ReDim returnList(count) As String

        resultIndex = 0

        For tempIndex = LBound(tempList) To UBound(tempList) Step 1

            If InStr(1, tempList(tempIndex), "}") > 0 Then
                returnList(resultIndex) = returnList(resultIndex) & "," & tempList(tempIndex)
            Else
                returnList(resultIndex) = tempList(tempIndex)
            End If

            If InStr(1, tempList(tempIndex), "{") = 0 Then
                resultIndex = resultIndex + 1
            End If

        Next tempIndex

    End If

    'Return rule list
    getRuleList = returnList

End Function

Private Function addMessage(ByRef dest As String, ByVal message As String)

    If IsEmpty(dest) Or dest = "" Then
        dest = message
    Else
        dest = dest & vbNewLine & message
    End If

End Function

我知道有很多代码行。所以,让我的代码看下面的解释。

编码说明

  

1。&#34; checkString&#34; 方法

It takes the following parameter:
inputString: the string for check
length     : the desired length for inputted string
position   : the position list which separated by comma
            ("{2,3,4}" and "[2-3]" are not valid for position but valid range like 2-3)
rule       : the rule list which separated by comma

It returns the result message as "Valid" for pass case.
And If it is not pass, error messages will come out.
  

2.&#34; getRuleList&#34; 方法

     

这种方法适用于什么?因为规则用逗号(,)分隔。但有时它包括范围规则,如 {2,3,4} 。所以,我们需要考虑一下。因此,此方法用于获取分离的规则列表。

     

3.&#34; addMessage&#34; 方法

     

此方法用于添加消息,因为我们可以看到一个或多个错误(即一个或多个位置有错误的字符)。

我使用以下代码测试了我的方法:

Public Sub testing()

    Dim returnMessage As String

    returnMessage = checkString("00465B", 6, "1,2-3,4-5,6", ">=1,[01-03],{4,5},A")

    If returnMessage <> "Valid" Then
        MsgBox returnMessage
    End If

End Sub

运行代码后,我收到以下消息:

enter image description here

我相信,这段代码对您有所帮助。我已经测试了代码,对我来说没问题。

如果有任何问题或代码错误,请与我们联系。

相关问题