我需要macrosExcel代码，这将检查我的string是否在正确的格式
这是我的整个代码，我将解释它，我想要添加。
第一个function是调用另外两个函数。
第二个函数是用来计算JMBG，这是我国公民的唯一编号。 第三个是计算PIB，这是公司的注册号码。
这两个function都可以，不需要移动或者其他任何东西。
我们需要改变这个第一个function。 正如你所看到的，在第一个函数中，我正在检查inputstring的长度是否正确。 如果长度是13个数字，我叫JMBG，如果是8我叫PIBfunction。 那没问题。
但是我必须在第一个函数中检查其他types的validation。 正如我所说，我的Excel单元格包含13个数字或8个数字。 我想在这个第一个函数中做一些规则，告诉我如果我的单元格除了那些8个数字或者13以外的其他东西都被填充，然后发送给我，msg告诉我单元格中有错误，然后这两个函数赢得了“不要叫。 正如你所看到的，我需要validation。
示例：单元格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 该解决scheme基于来自Scripting库的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
结果：用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
像这样的东西应该有所帮助 – 你可以在select语句中定义标准。 这是一个UDF，所以把代码放入一个模块，并input=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
如果基于公式的解决scheme是可以的 – 使用这个ARRAY公式（假设检查string在A1 ）：
=IF(OR(NOT(ISERROR(SEARCH(ROW($1:$10)-1,A1)))),"Has digits","No digits")
并按CTRL + SHIFT + ENTER而不是通常的ENTER – 这将定义一个ARRAY公式，并将导致{}括号内（但不要手动input）。
string长度和其他字符无关紧要。 希望有帮助）
用你的第一个函数replace下面的东西，用=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