2

これが私のコード全体であり、それと私が追加したいものを説明します。

最初の関数は、他の2つの関数を呼び出しています。

2番目の関数は、私の国の市民の一意の数であるJMBGを計算するために使用されます。3つ目は、企業の登録番号であるPIBの計算です。

これらの2つの機能は問題なく、移動する必要はありません。

この最初の関数を変更する必要があります。ご覧のとおり、最初の関数では、入力文字列の長さに問題がないかどうかを確認しています。長さが13の場合は、JMBGを呼び出し、8の場合は、PIB関数を呼び出します。それは大丈夫です。

ただし、この最初の関数で他のタイプの検証を確認する必要があります。私が言ったように、私のExcelセルには13個の数字または8個の数字が含まれています。この最初の関数で、セルが8個または13個以外のもので満たされているかどうかを通知するルールを作成し、セルにエラーがあり、他の2つの関数がエラーになることを通知するメッセージを送信します。呼ばれることはありません。ご覧のとおり、検証が必要です。

例:セルA1:1234567891234 ... 13個の数字があり、JMBGは08058808と呼ばれます... 8個の数字があり、PIBは1234567890123aSdf​​〜...エラーと呼ばれます。これは、小さな文字と大きな文字やその他の文字がフィールドにあるためです。

これらすべての合計として、PIBを呼び出すための8つの番号、JMBGを呼び出すための13の番号、およびエラーを送信する以外のすべての番号が必要です。

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
4

4 に答える 4

2

regexこのソリューションは、スクリプトライブラリに基づいています。私は3つのオブジェクトを使用しましたが、必要な3つの条件すべてをチェックするために、1つのオブジェクトのみを使用するようにコードを確実にトリミングします。挿入するテキストに関する情報が必要だったので、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

結果:関数としてサブを使用しました:

ここに画像の説明を入力してください


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
于 2013-01-29T09:57:31.367 に答える
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
于 2013-01-29T09:57:02.860 に答える
0

数式ベースのソリューションで問題がない場合-このARRAY数式を使用します(チェック用の文字列がにあると仮定しますA1)。

=IF(OR(NOT(ISERROR(SEARCH(ROW($1:$10)-1,A1)))),"Has digits","No digits")

通常の代わりにCTRL++を押しSHIFTます。これにより、ARRAY数式が定義され、括弧で囲まれます(ただし、手動で入力しないでください)。ENTERENTER{}

文字列の長さやその他の文字は関係ありません。お役に立てば幸いです)

于 2013-01-29T11:03:47.823 に答える
0

最初の関数を次のようなものに置き換え、セルA1=ProvjeraID2(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
于 2013-01-29T11:43:05.220 に答える