Мне нужен макро-код excel, который проверяет, соответствует ли моя строка в правильном формате

Вот мой весь код, и я объясню его и что хочу добавить.

Первая функция вызывает две другие функции.

Вторая функция используется для расчета JMBG, который является уникальным числом граждан в моей стране. Третий - это расчет PIB, который является зарегистрированным номером для компаний.

Эти две функции в порядке, и их не нужно перемещать или что-то в этом роде.

Нам нужно изменить эту первую функцию. Как вы можете видеть, в первой функции я проверяю, является ли длина входной строки в порядке. Если длина составляет 13 номеров, я вызываю JMBG, и если это 8, я вызываю функцию PIB. Все в порядке.

Но я должен проверить другие типы валидации в этой первой функции. Как я уже сказал, моя ячейка Excel содержит 13 номеров или 8 номеров. Я хочу сделать некоторые правила в этой первой функции, которые скажут мне, если моя ячейка заполнена чем-либо еще, кроме этих 8 чисел или 13, а затем отправьте мне сообщение, сообщая мне, что в ячейке есть ошибка, а те две другие функции, t будем называть. Как вы можете видеть, мне нужна проверка.

Пример: Cell A1: 1234567891234 ... есть 13 номеров, и JMBG будет называться                   08058808 ... есть 8 номеров, и PIB будет называться              1234567890123aSdf ​​~ ... ошибка, потому что маленькие и большие буквы и другие символы находятся в поле.

В качестве суммы всего этого мне нужно, чтобы 8 номеров вызывали PIB, для 13 номеров для вызова JMBG и для чего-либо еще, кроме как для отправки мне ошибки.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ProvjeraID(ID As String) As String

If Len(ID) = 13 Then
ProvjeraID = Provjeri_JMBG(ID)
 'Exit Function
ElseIf Len(ID) = 8 Then
 ProvjeraID = ProvjeriPIB(ID)
 'Exit Function
 Else
 ProvjeraID = "Duzina je razlicita od 8 i od 13"
 'Exit Function
End If

End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Provjeri_JMBG(JMBG As String) As String
' Funkcija vraca tekst sa opisom ispravnosti JMBG
' Primijeniti na radnom listu uz pomoc komande: =Proveri_JMBG(adresa)

' Inicijalizacija promenljivih koje se koriste prilikom izrade koda
Dim duzina As Integer, zbir As Integer
Dim cifra(1 To 13) As Integer
Dim dan As Integer, mesec As Integer, godina As String

' Inicijalizacija konstanti
Const ERR_dan = "GREŠKA: podatak o datumu neispravan!"
Const ERR_mesec = "GREŠKA: podatak o mesecu neispravan!"
Const ERR_godina = "GREŠKA: podatak o godini neispravan!"
Const ERR_duzina = "GREŠKA: dužina razlicita od 13!"
Const ERR_kont = "GREŠKA: neispravan kontrolni broj!"
Const OK_JMBG = "JMBG je ispravan"

' Preuzimanje ulaznih vrednosti sa kojima ce se vrsiti operacije
duzina = Len(JMBG)
dan = Int(Left(JMBG, 2))
mesec = Int(Mid$(JMBG, 3, 2))
godina = Mid$(JMBG, 5, 3)

' Provjera dužine JMBG
If (duzina <> 13) Then
  Provjeri_JMBG = "GREŠKA: dužina razlicita od 13!"
  Exit Function
End If

' Provjera datuma
If dan < 1 Then
  Provjeri_JMBG = "GREŠKA: podatak o datumu neispravan!"
  Exit Function
End If

' Provjera mjeseca i dana u mjesecu
Select Case mesec
  Case 1, 3, 5, 7, 8, 10, 12
    If dan > 31 Then
      Provjeri_JMBG = "GREŠKA: podatak o datumu neispravan!"
      Exit Function
    End If
  Case 4, 6, 9, 11
    If dan > 30 Then
      Provjeri_JMBG = "GREŠKA: podatak o datumu neispravan!"
      Exit Function
    End If
  Case 2
    If ((godina Mod 4 = 0) And dan > 29) Or _
       ((godina Mod 4 <> 0) And dan > 28) Then
      Provjeri_JMBG = "GREŠKA: podatak o datumu neispravan!"
      Exit Function
    End If
  Case Else
    Provjeri_JMBG = "GREŠKA: podatak o mesecu neispravan!"
    Exit Function
End Select

' Provjera godine: ispravne su od 1899 do tekuce godine
If (godina > Right(Str(Year(Now)), 3)) And (godina < "899") Then
  Provjeri_JMBG = "GREŠKA: podatak o godini neispravan!"
  Exit Function
End If

' Provjera kontrolnog broja
For i = 1 To 13
  cifra(i) = Int(Mid$(JMBG, i, 1))
Next i

zbir = cifra(13) + cifra(1) * 7 + cifra(2) * 6
zbir = zbir + cifra(3) * 5 + cifra(4) * 4
zbir = zbir + cifra(5) * 3 + cifra(6) * 2
zbir = zbir + cifra(7) * 7 + cifra(8) * 6
zbir = zbir + cifra(9) * 5 + cifra(10) * 4
zbir = zbir + cifra(11) * 3 + cifra(12) * 2

If (zbir Mod 11) <> 0 Then
  Provjeri_JMBG = "GREŠKA: neispravan kontrolni broj!"
Else
  Provjeri_JMBG = "JMBG je ispravan"
End If

End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function ProvjeriPIB(PIB As String)
Dim c0 As Integer
Dim c1 As Integer
Dim c2 As Integer
Dim c3 As Integer
Dim c4 As Integer
Dim c5 As Integer
Dim c6 As Integer
Dim c7 As Integer
Dim c8 As Integer
Dim zadnji As String
zadnji = Right(PIB, 1)
PIB = Left(PIB, 8)
If Len(PIB) <> 8 Then
   ProvjeriPIB = "PIB je OK"
Else
       c8 = (CInt(Mid(PIB, 1, 1)) + 10) Mod 10
       If c8 = 0 Then
         c8 = 10
       End If
       c8 = (c8 * 2) Mod 11
       c7 = (CInt(Mid(PIB, 2, 1)) + c8) Mod 10
       If c7 = 0 Then
         c7 = 10
       End If
       c7 = (c7 * 2) Mod 11
       c6 = (CInt(Mid(PIB, 3, 1)) + c7) Mod 10
       If c6 = 0 Then
         c6 = 10
       End If
       c6 = (c6 * 2) Mod 11
       c5 = (CInt(Mid(PIB, 4, 1)) + c6) Mod 10
       If c5 = 0 Then
         c5 = 10
       End If
       c5 = (c5 * 2) Mod 11
       c4 = (CInt(Mid(PIB, 5, 1)) + c5) Mod 10
       If c4 = 0 Then
         c4 = 10
       End If
       c4 = (c4 * 2) Mod 11
       c3 = (CInt(Mid(PIB, 6, 1)) + c4) Mod 10
       If c3 = 0 Then
         c3 = 10
       End If
       c3 = (c3 * 2) Mod 11
       c2 = (CInt(Mid(PIB, 7, 1)) + c3) Mod 10
       If c2 = 0 Then
         c2 = 10
       End If
       c2 = (c2 * 2) Mod 11
       c1 = (CInt(Mid(PIB, 8, 1)) + c2) Mod 10
       If c1 = 0 Then
         c1 = 10
       End If
       c1 = (c1 * 2) Mod 11
       c0 = (11 - c1) Mod 10
       If c0 <> zadnji Then
        ProvjeriPIB = "PIB je OK"
       Else
        ProvjeriPIB = "PIB nije OK"
       End If
       'return(pib || to_char(c0));

End If
End Function
2
nl ja de
Только если я увидел ваш комментарий здесь ............. это здорово, если бы вы указали, что вам нужно также проверить длину ... и не хочет ничего, кроме цифр
добавлено автор bonCodigo, источник
Можете ли вы показать нам исходный текст и ожидаемые результаты на основе этого? Пожалуйста, определите, по крайней мере, два примера, учитывая правильные правила, которые необходимо применять.
добавлено автор bonCodigo, источник
Использовать проверку данных для предотвращения не числовых записей
добавлено автор brettdj, источник
@MarkoD Я думаю, что если вам нужно выделить строки, содержащие все, кроме цифр - у меня есть решение, основанное исключительно на формулах. В случае, если это нормально - ответьте назад. Если вам нужен строго VBA - используйте один из предоставленных ответов.
добавлено автор Peter L., источник
Я поставил весь свой код. Видеть это.
добавлено автор MarkoD, источник
Вот пример. Мой код проверяет, введена ли в ячейке excel строка из 13 чисел. Все, кроме этого, должно быть возвращено как ошибка, например: «Ваша ячейка не содержит только числа, есть другие недопустимые символы»,
добавлено автор MarkoD, источник

4 ответы

Это решение основано на regex из библиотеки сценариев. Я использовал 3 объекта, но код определенно trimmed , чтобы использовать только один объект, чтобы проверить все три условия, которые вам нужны. Поскольку вам нужна информация о тексте, который вы вставляете, я просто использовал 3 разных правила regex .

Option Explicit

Sub TextNature()
Dim str  As String
Dim strMsg As String
Dim objRegEx1 As Object, objRegEx2 As Object
Dim objRegEx3 As Object

str = Sheets(1).Range("A2").Value

'--check length
If Len(str) <> 13 Then
   Exit Sub
   strMsg = "Too lengthy...limit should be 13"
End If

Set objRegEx1 = CreateObject("VBScript.RegExp")
Set objRegEx2 = CreateObject("VBScript.RegExp")
Set objRegEx3 = CreateObject("VBScript.RegExp")
objRegEx1.IgnoreCase = False
objRegEx1.Global = True
objRegEx2.IgnoreCase = False
objRegEx2.Global = True
objRegEx3.IgnoreCase = False
objRegEx3.Global = True


objRegEx1.Pattern = "^\d+$" '-- only numbers
objRegEx2.Pattern = "^[a-zA-Z]+$" '-- only lower upper letters
objRegEx3.Pattern = "^[a-zA-Z\d]+$" '-- numbers and lower upper letters

If objRegEx1.Test(str) Then
    strMsg = "Contain only numbers"
ElseIf objRegEx2.Test(str) Then
    strMsg = "Contain only lower upper letters"
ElseIf objRegEx3.Test(str) Then
    strMsg = "Contain numbers and lower upper letters"
Else
     strMsg = "not satisfying"
End If

End Sub

Результаты: используется как функция:

enter image description here


Запросы OP для функции, а ограничение длины - 8:

Option Explicit

Function TextNature(ByRef rng As Range) As String
Dim str  As String, strMsg As String
Dim objRegEx1 As Object, objRegEx2 As Object, objRegEx3 As Object

str = rng.Value
If Len(str) <> 8 Then
    TextNature = "Limit is not correct. It should be 8."
    Exit Function
End If

Set objRegEx1 = CreateObject("VBScript.RegExp")
Set objRegEx2 = CreateObject("VBScript.RegExp")
Set objRegEx3 = CreateObject("VBScript.RegExp")
objRegEx1.IgnoreCase = False
objRegEx1.Global = True
objRegEx2.IgnoreCase = False
objRegEx2.Global = True
objRegEx3.IgnoreCase = False
objRegEx3.Global = True


objRegEx1.Pattern = "^\d+$" '-- only numbers
objRegEx2.Pattern = "^[a-zA-Z]+$" '-- only lower/upper letters
objRegEx3.Pattern = "^[a-zA-Z\d]+$" '-- numbers and lower/upper letters

If objRegEx1.Test(str) Then
    strMsg = "Contain only numbers"
ElseIf objRegEx2.Test(str) Then
    strMsg = "Contain only lower upper letters"
ElseIf objRegEx3.Test(str) Then
    strMsg = "Contain numbers and lower upper letters"
Else
     strMsg = "Not Satisfying"
End If

TextNature = strMsg
End Function
2
добавлено
Готово. Но, пожалуйста, пройдите через это, потому что вы поправляетесь с кодом. Это важно, так как вам потребуется устранить неполадки при необходимости.
добавлено автор bonCodigo, источник
:) Это означает, что вы получаете значение в ячейке A2 в переменной String , называемой str . Причина, по которой я только дал вам подпрограмму, так что она все-таки дает вам возможность попробовать пространство, преобразовывая его в функцию.
добавлено автор bonCodigo, источник
@MarkoD все образцы, которые вы мне дали, не соответствуют правильной длине 13, поэтому я скорректировал их, пожалуйста, взгляните на снимок экрана, добавленный к вопросу. :) Я использовал одно и то же подрешение в ответе как функцию.
добавлено автор bonCodigo, источник
Ну, вы приняли другой ответ: почему вы хотели, чтобы мое решение было даже функцией?
добавлено автор bonCodigo, источник
можете ли вы дать мне пару комбинаций, которые у вас есть? Нечетный, он должен работать ..
добавлено автор bonCodigo, источник
+1 для вашего вопроса, так что в следующий раз вы также можете проголосовать за других :)
добавлено автор bonCodigo, источник
@MarkoD Код, который я предоставил, это Sub , вы можете изменить его на функцию следующим образом: Функция TextNature (ByRef rng as Range) как строка , добавьте TextNature = strMsg . то rng будет указывать на A1 , и функция вернет strMsg , который является строкой . Пожалуйста, покажите нам свой код
добавлено автор bonCodigo, источник
@MarkoD жаль, что я не могу его прочитать, но попробовали ли вы код, который я предоставил? Если вы хотите только проверить, что значение ячейки - это номер кода/номера , то вы можете просто удалить все другие объекты регулярного выражения, просто сохраните objRegEx1 :) Сообщите мне, как я могу вам помочь, если у вас есть любые другие проблемы с выполнением кода.
добавлено автор bonCodigo, источник
Вы можете задать свой вопрос, нажмите edit , затем append код на текст, который у вас уже есть. Если вы не сейчас, как форматировать, мы можем вам помочь
добавлено автор bonCodigo, источник
@brettdj Спасибо. Я должен признать, что я был ленивый ;)
добавлено автор bonCodigo, источник
Ну, как работает система, вы можете принимать только один пользователь. И если у вас недостаточно рекламы, вы не сможете проголосовать за другие ответы ... sigh :(
добавлено автор bonCodigo, источник
+1 но почему бы не использовать 1 объект не 3? :)
добавлено автор brettdj, источник
Ну, я думал, что я должен принять все ответы, если они верны не только тем, кого я использую ... Я так понял.
добавлено автор MarkoD, источник
Я начал свой код, и он всегда возвращает мне решение 4-не удовлетворяет ... для всех моих комбинаций ... Я вхожу 1234567, и он возвращается, как я уже сказал.
добавлено автор MarkoD, источник
Тогда ладно. Большое спасибо за эту функцию. Вы и все другие получили огромную помощь. Мы скоро услышим друг друга, если у меня возникнут другие трудности с решением других проблем. Я новичок в таком программировании, поэтому будьте терпеливы: D
добавлено автор MarkoD, источник
Хорошо. Я имею в виду, что вы помещаете туда, кроме 8, это также может быть 13. Это означает, что в одном цикле у вас есть 13 и 8, которые могут быть проверены. Если он не равен 8 и не равен 13
добавлено автор MarkoD, источник
Пожалуйста, вы можете преобразовать код в функцию, а не суб и добавить, кроме 13, что это может быть длина 8. Спасибо заранее друг.
добавлено автор MarkoD, источник
Можете ли вы объяснить мне эту строку кода: str = Листы (1) .Range («A2»). Также длина может быть 8. 13 и 8.
добавлено автор MarkoD, источник
1234567890, 123AAA, aaaaaaDDDDDD12345
добавлено автор MarkoD, источник
Я буду переводить некоторые части на английском, если вы не можете определить все
добавлено автор MarkoD, источник
Я переименовал код. Теперь вы можете увидеть мою проблему.
добавлено автор MarkoD, источник
Как добавить код здесь. Я новичок в этом портале.
добавлено автор MarkoD, источник
Почему мой код возвращает мне это: #VALUE!
добавлено автор MarkoD, источник

Если решение на основе формулы - ОК - используйте эту формулу ARRAY (если строка для проверки находится в A1 ):

= IF (OR (NOT (ISERROR (SEARCH (ROW ($ 1: $ 10) -1, A1)))), "Имеет цифры", "Нет цифр")

и нажмите CTRL + SHIFT + ENTER вместо обычного ENTER - это определит формулу ARRAY и приведет к {} скобки вокруг него (но НЕ вводите их вручную!).

Длина строки и любые другие символы не имеют значения. Надеюсь, что это было полезно)

0
добавлено

Что-то вроде этого должно помочь - вы можете определить критерии в инструкции select. Это UDF, поэтому поместите код в модуль и введите = checkcell (A1) в ячейку.

Public Function CheckCell(ByVal CheckRange As Range) As String
Dim strChr As String, rngCheck As Range
Dim i As Integer, NPC As Integer, UC As Integer, LC As Integer, OT As Integer
Set rngCheck = Range("A1")
For i = 1 To rngCheck.Characters.Count
    strChr = rngCheck.Characters(i, 1).Text
    Select Case Asc(strChr)
        Case 0 To 31
            NPC = NPC + 1
        Case 96 To 122
            LC = LC + 1
        Case 65 To 90
            UC = UC + 1
        Case Else
            OT = OT + 1
    End Select
Next
CheckCell = "NPC: " & NPC & " UC: " & UC & " LC: " & LC & " Others: " & OT
End Function
0
добавлено
Я понял. благодаря
добавлено автор MarkoD, источник
Это дает мне возвращаемое значение: #Value!
добавлено автор MarkoD, источник

Замените первую функцию следующим образом и вызовите ее в ячейке, используя = ProvjeraID2 (A1) , чтобы оценить содержимое ячейки A1 :

Function ProvjeraID2(oRng As Range) As String
    Dim sRet As String

    If Not oRng Is Nothing Then
        If IsNumeric(oRng.Value) Then
            If Len(oRng.Value) = 13 Then
                sRet = Provjeri_JMBG(CStr(oRng.Value))
            ElseIf Len(oRng.Value) = 8 Then
                sRet = ProvjeriPIB(CStr(oRng.Value))
            Else
                sRet = "Numeric but wrong length (" & Len(oRng.Value) & ")"
            End If
        Else
            sRet = "Not a number"
        End If
    End If

    ProvjeraID2 = sRet
End Function
0
добавлено
@MarkoD в случае, если вы довольны любым ответом - пожалуйста, отметьте это как принято, это будет означать, что поток был решен.
добавлено автор Peter L., источник
Хорошо, отлично! Добро пожаловать в SO.
добавлено автор Olle Sjögren, источник
Отличная работа !!! Это то, что я хочу иметь !!! Спасибо всем за помощь. Этот форум действительно хорош.
добавлено автор MarkoD, источник
ОК. Я сделаю это.
добавлено автор MarkoD, источник