我需要宏excel代码，它将检查我的字符串是否是正确的格式 [英] I need macro excel code which will check if my string is in the correct format
本文介绍了我需要宏excel代码，它将检查我的字符串是否是正确的格式的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
这是我的整个代码，我会解释一下，我想添加什么。
第一个函数是调用另外两个函数。
第二个功能用于计算JMBG，这是我所在国家的唯一公民人数。第三个是计算PIB，这是公司的注册号码。
这两个函数都可以，不需要移动或者这样的东西。 p>
我们需要改变这个第一个功能。正如你所看到的，在第一个函数中，我检查输入字符串的长度是否OK。如果长度是13个数字，我称之为JMBG，如果是8，我调用PIB函数。那没问题。
但是，我必须在第一个函数中检查其他类型的验证。正如我所说，我的Excel单元格包含13个数字或8个数字。我想在这个第一个函数中做出一些规则，告诉我，如果我的单元格填满了除了8个数字或13之外的其他任何东西，然后发送给我msg告诉我，在单元格中有错误，那两个其他的功能然后赢得'被叫。如您所见，我需要验证。
示例：单元格A1：1234567891234 ...有13个数字，JMBG将被称为
08058808 ...有8个数字，PIB将被称为
1234567890123aSdf〜...错误，因为小字母和大字母和其他字符都在字段中。
作为总和所有这一切，我需要8个号码叫PIB，13个号码叫JMBG和其他任何东西，除了发送我的错误。
'' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '''''''''''''''''''''$'$ b函数ProvjeraID $ b ProvjeraID = Provjeri_JMBG（ID）
'退出函数
ElseIf Len（ID）= 8然后
ProvjeraID = ProvjeriPIB（ID）
'退出函数
Else
ProvjeraID =Duzina je razlicita od 8 i od 13
'退出函数
结束If
结束函数
''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''$'$ '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整数，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žinarazlicita 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）
'ProvjeradužineJMBG
如果（duzina 13）然后
Provjeri_JMBG =GREŠKA：dužinarazlicita od 13！
退出函数
结束如果
'Provjera datuma
如果dan< 1然后
Provjeri_JMBG =GREŠKA：podatak o datumu neispravan！
退出函数
结束如果
'Provjera mjeseca我dana u mjesecu
选择案例mesec
案例1，3，5，7，8，10 ，12
如果dan> 31然后
Provjeri_JMBG =GREŠKA：podatak o datumu neispravan！
退出函数
结束If
案例4，6，9，11
如果dan> 30然后
Provjeri_JMBG =GREŠKA：podatak o datumu neispravan！
退出函数
结束If
案例2
如果（（godina Mod 4 = 0）And dan> 29）或_
（（godina Mod 4& > 0）and dan> 28）然后
Provjeri_JMBG =GREŠKA：podatak o datumu neispravan！
退出功能
结束如果
Case Else
Provjeri_JMBG =GREŠKA：podatak o mesecu neispravan！
退出函数
结束选择
'Provjera godine：ispravne su od 1899 do tekuce godine
如果（godina> Right（Str（Year（Now））） 3））And（godina<899）然后
Provjeri_JMBG =GREŠKA：podatak o godini neispravan！
退出函数
结束如果
'Provjera kontrolnog broja
对于i = 1到13
cifra（i）= Int（Mid $（JMBG， i，1））
Next i
zbir = cifra（13）+ cifra（1）* 7 + cifra（2）* 6
zbir = zbir + cifra ）* 5 + cifra（4）* 4
zbir = zbir + cifra（5）* 3 + cifra（6）* 2
zbir = zbir + cifra（7）* 7 + * 6
zbir = zbir + cifra（9）* 5 + cifra（10）* 4
zbir = zbir + cifra（11）* 3 + cifra（12）* 2
If（zbir Mod 11）< 0然后
Provjeri_JMBG =GREŠKA：neispravan kontrolni broj！
Else
Provjeri_JMBG =JMBG je ispravan
End If
End 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）
如果Len（PIB）<> 8然后
ProvjeriPIB =PIB je OK
Else
c8 =（CInt（Mid（PIB，1，1））+ 10）Mod 10
如果c8 = 0则
c8 = 10
如果
c8 =（c8 * 2）Mod 11
c7 =（CInt（Mid（PIB，2，1））+ c8）Mod 10
如果c7 = 0然后
c7 = 10
结束如果
c7 =（c7 * 2）Mod 11
c6 =（CInt（Mid（PIB，3，1 ））+ c7）Mod 10
如果c6 = 0然后
c6 = 10
结束如果
c6 =（c6 * 2）Mod 11
c5 =（CInt （中（PIB，4,1））+ c6）Mod 10
如果c5 = 0然后
c5 = 10
结束如果
c5 =（c5 * 2）Mod 11
c4 =（CInt（Mid（PIB，5，1））+ c5）Mod 10
如果c4 = 0然后
c4 = 10
如果
c4 =（c4 * 2）Mod 11
c3 =（CInt（Mid（PIB，6,1））+ c4）Mod 10
如果c3 = 0然后
c3 = 10
End If
c3 =（c3 * 2）Mod 11
c2 =（CInt（Mid（PIB， 7，1））+ c3）Mod 10
如果c2 = 0则
c2 = 10
如果
c2 =（c2 * 2）Mod 11
c1 =（CInt（Mid（PIB，8,1））+ c2）Mod 10
如果c1 = 0则
c1 = 10
如果
c1 =（c1 * 2 ）Mod 11
c0 =（11 - c1）Mod 10
如果c0 < zadnji然后
ProvjeriPIB =PIB je OK
Else
ProvjeriPIB =PIB nije OK
End If
'return（pib || to_char（c0）） ;
结束如果
结束函数
解决方案
此解决方案基于脚本库中的 regex 。我已经使用了3个对象，但代码肯定是修剪仅使用一个对象来检查所需的所有三个条件。由于您需要有关插入文本的信息，所以我仅使用了3个不同的正则表达式规则。
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
如果Len str）< 13然后
退出Sub
strMsg =太长...限制应该是13
结束如果
设置objRegEx1 = CreateObject（VBScript.RegExp）
设置objRegEx2 = CreateObject（VBScript.RegExp）
设置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 + $' - 只有数字
objRegEx2.Pattern =^ [a-zA-Z] + $' - 只有较低的高位字母
objRegEx3.Pattern =^ [ a-zA-Z\d] + $' - 数字和低位字母
如果objRegEx1.Test（str）然后
strMsg =仅包含数字
ElseIf objRegEx2.Test（str）然后
strMsg =仅包含较低的上部字母
ElseIf objRegEx3.Test（str）然后
strMsg =包含数字和低字母
Else
strMsg =不满意
如果
End Sub
结果：使用子功能： p>
功能的OP请求，长度限制为8：
String
$ b函数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
如果Len（str）<> 8然后
TextNature =限制不正确，应该是8.
退出函数
结束如果
设置objRegEx1 = CreateObject（VBScript.RegExp）
设置objRegEx2 = CreateObject（VBScript.RegExp）
设置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 + $' - 只有数字
objRegEx2.Pattern =^ [a-zA-Z] + $' - 只有较低/高位字母
objRegEx3.Pattern =^ [a-zA-Z\d] + $' - 数字和较低/ upper letter
如果objRegEx1.Test（str）然后
strMsg =只包含数字
ElseIf objRegEx2.Test（str）然后
strMsg =包含只有较低的高字母
ElseIf objRegEx3.Test（str）然后
strMsg =包含数字和低字母
Else
strMsg =不满意
结束如果
TextNature = strMsg
结束函数
Here is my entire code and I will explain it and what I want to add.
The first function is calling two other functions.
The second function is used to calculate JMBG, which is unique number of citizen in my country. The third one is calculating PIB, which is registered number for companies.
Those two functions are OK and they don't need to be moved or anything like that.
We need to change this first function. As you can see, in the first function I am checking whether the length of the input string is OK. If the length is 13 numbers I call JMBG and if it is 8 I call PIB function. That is OK.
But I must check other types of validation in this first function. As I said, my Excel cell contains 13 numbers or 8 numbers. I want to make some rules in this first function that will tell me if my cell is filled with anything else except those 8 numbers or 13, then send me msg telling me that there is error in the cell and those 2 other functions then won't be called. As you can see, I need validation.
Example: Cell A1: 1234567891234...there is 13 numbers and JMBG will be called 08058808...there is 8 numbers and PIB will be called 1234567890123aSdf~...error because small and big letters and other characters are in the field.
As sum of all this, I need for 8 numbers to call PIB, for 13 numbers to call JMBG and for anything else except that to send me error.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
解决方案
This solution is based on regex from Scripting library. I have used 3 objects, but code definitely be trimmed to use just one object to check for all three conditions that you required. Since you wanted information about the text that you are inserting I have merely used 3 different regex rules.
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
Results : used the sub as a function:
OP requests for a function, and length limit to be 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
这篇关于我需要宏excel代码，它将检查我的字符串是否是正确的格式的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
