vba 我需要宏 excel 代码来检查我的字符串是否格式正确
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/14579466/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
I need macro excel code which will check if my string is in the correct format
提问by MarkoD
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.
第二个函数用于计算 JMBG，这是我所在国家/地区唯一的公民数。第三个是计算PIB，这是公司的注册号。
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.
我们需要改变第一个函数。如您所见，在第一个函数中，我正在检查输入字符串的长度是否正常。如果长度是 13 个数字，我调用 JMBG，如果它是 8 个，我调用 PIB 函数。那没问题。
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.
但是我必须在第一个函数中检查其他类型的验证。正如我所说，我的 Excel 单元格包含 13 个数字或 8 个数字。我想在第一个函数中制定一些规则，告诉我我的单元格是否填充了除 8 个数字或 13 之外的其他任何内容，然后向我发送消息，告诉我单元格中存在错误，然后其他 2 个函数将无效不叫。如您所见，我需要验证。
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.
示例：单元格 A1：1234567891234...有 13 个数字，JMBG 将被称为 08058808...有 8 个数字，PIB 将被称为 1234567890123aSdf~...错误，因为大小写字母和其他字符在字段中。
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.
作为所有这些的总和，我需要 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
采纳答案by bonCodigo
This solution is based on regexfrom Scripting library. I have used 3 objects, but code definitely be trimmedto 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 regexrules.
此解决方案基于regex脚本库。我已经使用了 3 个对象，但代码肯定会被修剪为仅使用一个对象来检查您需要的所有三个条件。由于您想要有关您插入的文本的信息，因此我仅使用了 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
Results : used the sub as a function:
结果：将 sub 用作函数：
OP requests for a function, and length limit to be 8:
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
回答by Peter L.
In case formula-based solution is OK - use this ARRAYformula (assuming string for checking is in A1):
如果基于公式的解决方案没问题 - 使用这个ARRAY公式（假设检查字符串在A1）：
=IF(OR(NOT(ISERROR(SEARCH(ROW($1:$10)-1,A1)))),"Has digits","No digits")
=IF(OR(NOT(ISERROR(SEARCH(ROW($1:$10)-1,A1)))),"Has digits","No digits")
and press CTRL+SHIFT+ENTERinstead of usual ENTER- this will define an ARRAY formula and will result in {}brackets around it (but do NOT type them manually!).
并按CTRL+ SHIFT+ENTER而不是通常的ENTER- 这将定义一个 ARRAY 公式并{}在它周围产生括号（但不要手动输入它们！）。
String length and any other chars do not matter. Hope that was helpful)
字符串长度和任何其他字符都无关紧要。希望有帮助）
回答by Olle Sj?gren
Replace your first function with something like the following, and call it in a cell using =ProvjeraID2(A1)to evaluate the contents of cell A1:
将您的第一个函数替换为如下所示的内容，并在单元格中调用它，=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
回答by MattCrum
Something like this should help - you can define the criteria in the select statement. It's a UDF so put the code into a module and enter =checkcell(A1)into a cell.
这样的事情应该会有所帮助 - 您可以在 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
