Access VBA - создать проверку формулы Textbox (проверить последнюю цифру)

Я должен создать некоторую проверку числового поля для введенных значений в Textbox с формулой в VBA, но не знаю, как вообще начать. Вот пример:

Значение поля текстового поля - 132549

  1. Вы исключаете 6, поэтому вы используете 13254

  2. затем вы делаете продукт и суммируете с другими числами, такими как: 4*2 + 5*3 + 2*3 + 3*4 + 1*5 = 46

  3. тогда вы делаете 46 мод 11 = 2

  4. тогда 11 минус 2 = 9 и результат здесь должен соответствовать последней цифре (в этом примере последняя цифра верна)

Я программист среднего уровня VBA, но это над моей головой. Любой совет высоко ценится!

Источник

4 ответа

Решение

Я решил это самостоятельно - я знаю, что это выглядит немного по-детски, но это работает так, как должно.

  Sub test()

        Dim Seven As Integer
        Dim Six As Integer
        Dim Five As Integer
        Dim Four As Integer
        Dim Three As Integer
        Dim Two As Integer
        Dim One As Integer

        Dim Seven_Sum As Integer
        Dim Six_Sum As Integer
        Dim Five_Sum As Integer
        Dim Four_Sum As Integer
        Dim Three_Sum As Integer
        Dim Two_Sum As Integer
        Dim One_Sum As Integer

        Dim All_Sum As Integer
        Dim Do_Modulus As Integer
        Dim Check_Digit As Integer

        Seven = Mid(Text0, 7, 1)
        Seven_Sum = Seven * 2

        Six = Mid(Text0, 6, 1)
        Six_Sum = Six * 3

        Five = Mid(Text0, 5, 1)
        Five_Sum = Five * 4

        Four = Mid(Text0, 4, 1)
        Four_Sum = Four * 5

        Three = Mid(Text0, 3, 1)
        Three_Sum = Three * 6

        Two = Mid(Text0, 2, 1)
        Two_Sum = Two * 7

        One = Mid(Text0, 1, 1)
        One_Sum = One * 8

        All_Sum = Seven_Sum + Six_Sum + Five_Sum + Four_Sum + Three_Sum + Two_Sum + One_Sum

        Do_Modulus = All_Sum Mod 11
        Check_Digit = 11 - Do_Modulus

'Finally check for correct serial number validation based on last digit in Textbox
        If Mid(Text0, 8, 1) <> Check_Digit Then

        MsgBox "This serial number is faulty. Last digit of this entered serial number should be :" & Check_Digit
        End If

        End Sub
Источник

Вы должны написать пользовательскую функцию, которая будет принимать число в качестве входного параметра и возвращать логическое значение (true/false). Реализация "ленивого программиста" может выглядеть так:

Public Function IsValidNumber(ByVal iNum As Long) As Boolean
Dim consums As String, digits As String
Dim i As Integer, j As Integer

'control sums
consums = "23345"
'convert number to its string representation and reject last digit
digits = Left(CStr(iNum), 5)
'reverse string
digits = StrReverse(digits)
'loop through the chars in string
For i = 1 To Len(digits)
    'convert single char to digit and calculate sum
    j = j + CInt(Mid(digits, i, 1)) * CInt(Mid(consums, i, 1))
Next
'get modulo
i = j Mod 11
'deduct the result of modulo from constant
j = 11 - i

'return
IsValidNumber = (j = CInt(Right(CStr(iNum), 1)))

End Function

Как это назвать? Создайте процедуру, как показано ниже:

Sub Test()
Dim i As Long

i = 132549

MsgBox IsValidNumber(i)

End Sub

Запустить его (F5) и проверьте что получится.

Примечание: вы должны добавить новый модуль, чтобы иметь возможность вставлять в него вышеуказанный код.

Смотрите ниже "визуальное представление" for...next петли шагов.

|==================================================|
| Iteration | Control number | Current digit | Sum |
| (step)    |  (multiplier)  |(reverse order)|     |
|==================================================|
|     1     |        2       |       4       |   8 |
|     2     |        3       |       5       |  15 |
|     3     |        3       |       2       |   6 |
|     4     |        4       |       3       |  12 |
|     5     |        5       |       1       |   5 |
|==================================================|
Источник

Я спрашиваю о коде VBA для формулы выше, я знаю, как использовать кодирование Access и VBA. Мне нужен кто-то, кто скажет мне, как я должен извлечь каждое число из текстового поля, умножить их и суммировать эти результаты. Затем используйте функцию Mod и так далее, как описано в вопросе.

Как я понимаю, главная проблема - получить цифры из текста. Я думаю, что вы можете использовать следующую логику (это показывает только идею).

Dim nLen as Integer    
Dim stInput as string

stInput = nz(Me.Field)
nLen = Len(stInput)

Dim arrNumbers(nLen) As Integer
Dim nIndex asInteger
dim nValue as Intger

For nIndex = 0 to nLen
    nValue = Mid(stInput, nIndex, 1)
    arrNumbers(nIndex) = nValue
Next nIndex

'-- you can use arrNumbers to get access to your numbers
Источник

То, что вы просите, это, вероятно, проверка модуля 11. Вы также можете иметь проверку Modulus-10, и оба могут быть объединены в одну функцию:

Public Function ModulusCheck(ByVal strNum As String, ByVal intModulus As Integer) As Integer

  ' Checks that strNum is a Modulus-10 or -11 number with
  ' a valid check digit.
  ' Non-numeric characters are ignored.

  ' Maximum length of number.
  Const cintNumLenMax = 32

  Dim strChk    As String
  Dim strTmp    As String
  Dim strVal    As String
  Dim intChr    As Integer
  Dim intLen    As Integer
  Dim intSum    As Integer
  Dim intVal    As Integer
  Dim intWeight As Integer
  Dim intCount  As Integer
  Dim intChk    As Integer

  Select Case intModulus
    Case 10, 11
      intLen = Len(strNum)
      If intLen > 0 Then
        ' Remove non-numeric characters.
        For intCount = 1 To intLen
          intChr = Asc(Mid(strNum, intCount))
          If intChr >= 48 And intChr <= 57 Then
            strTmp = strTmp & Chr(intChr)
          End If
        Next intCount
        strNum = strTmp
        intLen = Len(strNum)

        If intLen > 1 Then
          If intLen <= cintNumLenMax Then
            ' Separate number and check digit.
            strVal = Mid(strNum, 1, intLen - 1)
            strChk = Mid(strNum, intLen, 1)
            For intCount = 1 To intLen - 1
              intVal = Val(Mid(strVal, intLen - intCount, 1))
              Select Case intModulus
                Case 10
                  intWeight = 1 + (intCount Mod 2)
                  intVal = intWeight * intVal
                  intVal = Int(intVal / 10) + (intVal Mod 10)
                Case 11
                  intWeight = 2 + ((intCount - 1) Mod 6)
                  intVal = intWeight * intVal
              End Select
              intSum = intSum + intVal
            Next intCount
            intSum = intSum + Val(strChk)
            intChk = (intSum Mod intModulus = 0)
          End If
        End If
      End If
  End Select

  ModulusCheck = intChk

End Function

Чтобы проверить число, функция вернет True для OK. Тем не мение:

ValidNumber = ModulusCheck("132549", 11)

будет ложным, пока:

ValidNumber = ModulusCheck("132543", 11)

возвращает True.

Так что либо у вас есть нестандартная проверка, либо вы ошиблись с 9 или 6, поскольку контрольная цифра для "13254" для прохождения проверки по модулю-11 равна 3.

Источник
Другие вопросы по тегам