PDA

View Full Version : How to test for characters in a specific set?



Jennifer
02-16-2017, 11:00 PM
Is there a way for me to test whether a UDF string parameter contains only characters from a predefined character set without having to loop through each character?



Function MyFun(Code As String) As Double
Const CharSet As String = "ANP*-$#"
. . .


How can I test whether Code contains only characters in CharSet?

YasserKhalil
02-16-2017, 11:08 PM
I don't think it is possible without loops. It would loop each character to check its existence

Jennifer
02-16-2017, 11:16 PM
I don't think it is possible without loops. It would loop each character to check its existence
Rats. That's what I was afraid of. Thanks.

GTO
02-17-2017, 02:01 AM
Greetings Jennifer,

Maybe a simple RegExp?



Option Explicit

Public Function udfCharSet(ByVal CellText As String, Optional ByVal CharSet As String = "ANP*-$#") As Boolean
Static REX As Object
Dim n As Long
Dim sTmp As String

'Static, as an IF is quicker than setting a new reference each call
If REX Is Nothing Then
Set REX = CreateObject("VBScript.RegExp")
End If

' In case the cell is empty
If CellText = vbNullString Then
udfCharSet = True
Exit Function
End If

' Add a backslash to precede each character to insist literal. If CharSet will actually
' be constant, then you don't need this, but do need to add a backslash to the pattern
' in front of stuff like '*'. See https://msdn.microsoft.com/en-us/library/ms974570.aspx
For n = Len(CharSet) To 1 Step -1
sTmp = "\" & Mid$(CharSet, n, 1) & sTmp
Next

With REX
.Global = False
.IgnoreCase = False
.Pattern = "[^" & sTmp & "]"
udfCharSet = Not .Test(CellText)
End With

End Function


Hope that helps,

Mark

snb
02-17-2017, 02:08 AM
Msgbox instr("aaaa ANP*-$# bbbb","ANP*-$#" )

Paul_Hossler
02-17-2017, 07:52 AM
There used to be a Windows API (Shlwapi.dll) that would do it, but I don't think it's available any more

I think that some kind of loop is needed, but you can make it as efficient as possible

I tried adding logic to remove duplicated characters from the string being tested, but that added processing time some it just seemed more efficient to keep it simple

So in the example, 'A' is checked 4 times in "AAAANNNPPP****----$$$$$#####"




Option Explicit
Function OnlyCertainChar(OnlyTheseAllowed As String, CheckThis As String) As Boolean
Dim i As Long

OnlyCertainChar = False

For i = 1 To Len(CheckThis)
If InStr(OnlyTheseAllowed, Mid(CheckThis, i, 1)) = 0 Then Exit Function
Next I

OnlyCertainChar = True
End Function


Sub test()
MsgBox OnlyCertainChar("ANP*-$#", "ZAAAANNNPPP****----$$$$$#####")
MsgBox OnlyCertainChar("ANP*-$#", "AAAANNNPPP****----$$$$$#####")

End Sub

snb
02-17-2017, 08:30 AM
msgbox replace(replace(replace(replace(replace(replace(replace("aaaa ANP*-$# bbbb","A",""),"N",""),"P",""),"*",""),"-",""),"$",""),"#","")=""

GTO
02-17-2017, 08:32 AM
Maybe I am misunderstanding, but as I understand it, I think w/o a loop...



Option Explicit

Public Function udfCharSetConst(ByVal CellText As String) As Boolean
Static REX As Object
Dim n As Long
Dim sTmp As String

If REX Is Nothing Then
Set REX = CreateObject("VBScript.RegExp")
End If

If CellText = vbNullString Then
udfCharSetConst = True
Exit Function
End If

With REX
.Global = False
.IgnoreCase = False
.Pattern = "[^ANP\*\-\$#]"
udfCharSetConst = Not .Test(CellText)
End With

End Function

Paul_Hossler
02-17-2017, 08:32 AM
Another approach that tries to avoid string manipulation trades speed for complexity

This uses integer arrays and a 'quick exit' if the string being checked has a char max/min that exceeds the max/min of the allowed characters. No looping this way



Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, src As Any, ByVal bytes As Long)

Function OnlyCertainChar1(ByVal OnlyTheseAllowed As String, ByVal CheckThis As String) As Boolean
Dim i As Long, x As Long
Dim aOnly() As Integer, aCheck() As Integer

ReDim aOnly((LenB(OnlyTheseAllowed) - 1) \ 2)
ReDim aCheck((LenB(CheckThis) - 1) \ 2)


CopyMemory aOnly(0), ByVal StrPtr(OnlyTheseAllowed), LenB(OnlyTheseAllowed)
CopyMemory aCheck(0), ByVal StrPtr(CheckThis), LenB(CheckThis)


With Application.WorksheetFunction

'quick check
OnlyCertainChar1 = False
If .Max(aCheck) > .Max(aOnly) Then Exit Function
If .Min(aCheck) < .Min(aOnly) Then Exit Function

'slower check
OnlyCertainChar1 = True

On Error GoTo NotOnList
For i = LBound(aCheck) To UBound(aCheck)
x = .Match(aCheck(i), aOnly, 0)
Next I

Exit Function
End With

NotOnList:
OnlyCertainChar1 = False
End Function

Sub test()
MsgBox OnlyCertainChar1("ANP*-$#", "ZAAAANNNPPP****----$$$$$#####")
MsgBox OnlyCertainChar1("ANP*-$#", "AAAANNNPPP****----$$$$$#####")
End Sub