Just as the title says whats the fastest way to check if a userinput contains a punctuations except / , i'm New to VBA and struggeling with this for A couple of hours now
See if the string contains anything thats not A to Z, 0 to 9 or /
hasPunctuation = astring like "*[!A-Za-z0-9/]*"
If all you want is letters, numerals, and the slash then is one way:
Sub PuncCheck()
Dim strng1 As String, strng2 As String
strng1 = "qwerty12345678~!##$%^&*()_+"
strng2 = "qwerty12345678/"
Call StringCheck(strng1)
Call StringCheck(strng2)
End Sub
Sub StringCheck(sIN As String)
Dim i As Long, sCH As String
For i = 1 To Len(sIN)
sCH = Mid(sIN, i, 1)
If sCH Like "[0-9a-zA-Z]" Or sCH = "/" Then
Else
MsgBox "string has junk"
Exit Sub
End If
Next i
MsgBox "string has no junk"
End Sub
Related
I have a rather tricky problem with my ongoing project.
I pretty much need to extract ceritain Strings between muliple delimiters out of a bigger String.
To give you a better understanding, what I mean, here is an example:
Some Text that wont be needed
Some Text that wont be needed
Some Text that wont be needed
Some Text that wont be needed
Some Text that wont be needed
Textstart (Start-Delimiter)
Text I want
Text I want
Text I want
Text I want
Text I want
Textend (End-Delimiter)
So far, so easy. But now comes a messy part in. The End-delimiters change sometimes like this
Textstart
Text I want
Text I want
Text I want
Text I want
Textend2 (another end delimiter)
I also solved that Problem, but now since I discovered, that the start delimiter can also occur twice before the next endpart.
Like this:
Textstart (Start-Delimiter)
Text I want
Text I want
Textstart
Text I want
Text I want
Textend (End-Delimiter)
This really is confusing to me. This is the function right now. It works but only if the start delimiter does not occur twice.
I could split the text first by the end strings and after that by the start string, but I don't know hot to split a text by multiple delimiters.
Function NewTextGet(ByVal Text As String, ByVal StartString As String, ByVal EndStrings() As String)
Dim AllBlocks As New List(Of String)
Dim FirstSplit() As String = Strings.Split(Text, StartString) ' Splits Text at Start delimiter
For Each splt In FirstSplit.Skip(1)
Dim EndSplit1 = splt.Split({EndStrings(0)}, StringSplitOptions.None) ' First end delimiter Split
Dim EndSplit2 = EndSplit1(0).Split({EndStrings(1)}, StringSplitOptions.None) ' Second delimiter Split
Dim EndSplit3 = EndSplit2(0).Split({EndStrings(2)}, StringSplitOptions.None) ' Third delimiter Split
If EndSplit3.Length > 1 Then
AllBlocks.Add(EndSplit3(0))
ElseIf EndSplit2.Length > 1 Then
AllBlocks.Add(EndSplit2(0))
Else
AllBlocks.Add(EndSplit1(0))
End If
Next
Return AllBlocks
End Function`
I hope I explained this well enough, and thank you for any help :)
This version produces a List(Of List(OF String)). So each set of lines will be in a different list:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim fileName As String = "C:\Users\mikes\Downloads\gYeziPRE.txt"
Dim blocks As List(Of List(Of String)) = NewTextGet(My.Computer.FileSystem.ReadAllText(fileName), "ctxt", New String() {"done", "sdone", "prompt"})
For i As Integer = 0 To blocks.Count - 1
Debug.Print("Block: " & i)
For Each line As String In blocks(i)
Debug.Print(line)
Next
Debug.Print("")
Next
End Sub
Function NewTextGet(ByVal Text As String, ByVal StartString As String, ByVal EndStrings() As String) As List(Of List(Of String))
Dim started As Boolean = False
Dim curBlock As List(Of String)
Dim AllBlocks As New List(Of List(Of String))
Dim lines() As String = Text.Split(Environment.NewLine)
For Each line As String In lines
If line.Contains(StartString) Then
If Not started Then
started = True
curBlock = New List(Of String)
End If
Dim i As Integer = line.IndexOf(StartString)
curBlock.Add(line.Substring(i + StartString.Length).Trim())
ElseIf EndStrings.Contains(line.Trim()) Then
started = False
If Not IsNothing(curBlock) Then
AllBlocks.Add(curBlock)
End If
curBlock = Nothing
ElseIf started = True AndAlso Not IsNothing(curblock) Then
curBlock.Add(line.Trim())
End If
Next
If Not IsNothing(curBlock) Then
AllBlocks.Add(curBlock)
End If
Return AllBlocks
End Function
Output:
Block: 0
"What's up?"
para "All these Trainers"
line "look the same, but"
para "only one is the"
line "leader!"
Block: 1
"Am I Koji?"
para "Why, yes, I am!"
Block: 2
"Well done!"
para "Here!"
para "The Fist Badge!"
Block: 3
"<PLAYER> received"
line "Fist Badge."
Block: 4
"Here!"
para "Take this TM!"
Block: 5
"Hah!"
para "That was joyful"
line "sparring!"
Block: 6
"Japanese"
line "onomatopoeia"
cont "are so kawaii!"
Block: 7
"Hiri hiri!"
Block: 8
"Uwaaaa!"
Block: 9
"Well, you chose"
line "unwisely."
Block: 10
"You have more"
line "chances."
Block: 11
"Koji is hot."
para "Dressing like him"
line "is<...>"
para "wonderful!"
Block: 12
"Wasn't supposed"
line "to happen!"
Block: 13
"Can't wait for"
line "Halloween!"
Block: 14
"Ninjas are so"
line "cool!"
Block: 15
"Not skilled"
line "enough!"
Block: 16
"Time to study"
line "ninjutsu instead"
cont "of pretending."
Try this
Function NewTextGet(ByVal RawText As String, ByVal StartString As String, ByVal EndStrings() As String) As List(Of String)
Dim bEnd As List(Of String) = EndStrings.ToList
bEnd.Insert(0, StartString)
Dim Blocks As New List(Of String)
Dim Splits() As String = Split(RawText, vbNewLine, , CompareMethod.Text)
For x As Integer = 0 To Splits.Length - 1
1:
Dim block As String = ""
If Splits(x).Contains(StartString) Then
block = Splits(x)
For y As Integer = x + 1 To Splits.Length - 1
Dim BlockEnd As Boolean = False
For Each s As String In bEnd
If Splits(y).Contains(s) Then BlockEnd = True
Next
block &= vbNewLine
If BlockEnd Then
If Splits(y).Contains(StartString) Then
Blocks.Add(block & vbNewLine)
x = y - 1
GoTo 1
End If
x = y + 1
block &= Splits(y)
Blocks.Add(block & vbNewLine)
Exit For
End If
block &= Splits(y)
Next
End If
Next
Return Blocks
End Function
usage
For Each s As String In NewTextGet(Raw, "ctxt", New String() {"sdone", "done", "prompt"})
TextBox2.Text &= s & "=======" & vbNewLine
Next
use this order {"sdone", "done", "prompt"} to avoid conflection while spliting
I'm trying to obtain two codes from this string: "HL PNX-70[15200]"
But with this code, I obtain two times the same output: "HL PNX-70". So, the code is not properly done.
How to obtain the output '15200' from the above mentioned String?
Code:
Private Sub Comando221_Click()
MsgBox (Right(Split("HL PNX-70[15200]", "[")(0), 50))
MsgBox (Left(Split("HL PNX-70[15200]", "[")(0), 50))
End Sub
Are you looking for this ?
Sub Test()
MsgBox Split("HL PNX-70[15200]", "[")(0)
MsgBox Replace(Split("HL PNX-70[15200]", "[")(1), "]", "")
End Sub
Split returns a zero-based array so you are interested in the second element, index 1. Both lines of your code are extracting "HL PNX-70" and the leftmost and rightmost 50 characters will clearly be the same.
This code illustrates two ways of extracting the desired string for your specific example, but it is not necessarily ironclad if you are working with multiple different types of string. You could also use Instr, as per the other answer, or look at regular expressions if you need more complex pattern matching.
Sub y()
Dim s As String, v
s = "HL PNX-70[15200]"
v = Split(s, "[")
Debug.Print v(0) 'HL PNX-70
Debug.Print v(1) '15200]
MsgBox Left(v(1), Len(v(1)) - 1) '15200
v = Split(v(1), "]")
MsgBox v(0) '15200
End Sub
You could try:
Option Explicit
Sub Test()
Dim str As String, Result As String
Dim Start_Point As Long, No_Characters As Long
str = "HL PNX-70[15200]"
Start_Point = InStr(str, "[") + 1
No_Characters = Len(str) - Start_Point
Result = Mid(str, Start_Point, No_Characters)
Debug.Print Result
End Sub
Here is your code
Dim text, text1, text2 As String
text = "HL PNX-70[15200]"
text1 = Break_String(CStr(text), 0)
text2 = Break_String1(Break_String(CStr(text), 1))
Function Break_String(a As String, pos As Integer) As String
Dim WrdArray() As String
WrdArray() = Split(a, "[")
Break_String = WrdArray(pos)
End Function
Function Break_String1(a As String) As String
Dim WrdArray() As String
WrdArray() = Split(a, "]")
Break_String1 = WrdArray(0)
End Function
I am having a column which contains integer values with two special character "," and "_". I am trying to remove these character for example 1,10_2,2_3,3 should be like 1102233. Thanks in advance for your suggestions.
this function isn't foolproof but it is a good start.
Function trim(aStringToTrim As String, aElementToTrinm() As Variant) As String
Dim elementToTrim As Integer
Dim IndexInString As Integer
For elementToTrim = LBound(aElementToTrinm) To UBound(aElementToTrinm)
IndexInString = InStr(aStringToTrim, aElementToTrinm(elementToTrim))
Do While IndexInString > 0
aStringToTrim = Left(aStringToTrim, IndexInString - 1) & Right(aStringToTrim, Len(aStringToTrim) - IndexInString - Len(aElementToTrinm(elementToTrim)) + 1)
IndexInString = InStr(aStringToTrim, aElementToTrinm(elementToTrim))
Loop
Next
End Function
It can be use like this:
Sub main()
Dim myString As String
Dim caracterstoRemove As Variant
caracterstoRemove = Array(",", ".")
myString = "This, is. a, string, with. caracters to remove."
myString = trim(myString, caracterstoRemove)
End Sub
the vb.net code below permutates a given word...the problem i have is that it does not accept larger words like "photosynthesis", "Calendar", etc but accepts smaller words like "book", "land", etc ...what is missing...Pls help
Module Module1
Sub Main()
Dim strInputString As String = String.Empty
Dim lstPermutations As List(Of String)
'Loop until exit character is read
While strInputString <> "x"
Console.Write("Please enter a string or x to exit: ")
strInputString = Console.ReadLine()
If strInputString = "x" Then
Continue While
End If
'Create a new list and append all possible permutations to it.
lstPermutations = New List(Of String)
Append(strInputString, lstPermutations)
'Sort and display list+stats
lstPermutations.Sort()
For Each strPermutation As String In lstPermutations
Console.WriteLine("Permutation: " + strPermutation)
Next
Console.WriteLine("Total: " + lstPermutations.Count.ToString)
Console.WriteLine("")
End While
End Sub
Public Sub Append(ByVal pString As String, ByRef pList As List(Of String))
Dim strInsertValue As String
Dim strBase As String
Dim strComposed As String
'Add the base string to the list if it doesn't exist
If pList.Contains(pString) = False Then
pList.Add(pString)
End If
'Iterate through every possible set of characters
For intLoop As Integer = 1 To pString.Length - 1
'we need to slide and call an interative function.
For intInnerLoop As Integer = 0 To pString.Length - intLoop
'Get a base insert value, example (a,ab,abc)
strInsertValue = pString.Substring(intInnerLoop, intLoop)
'Remove the base insert value from the string eg (bcd,cd,d)
strBase = pString.Remove(intInnerLoop, intLoop)
'insert the value from the string into spot and check
For intCharLoop As Integer = 0 To strBase.Length - 1
strComposed = strBase.Insert(intCharLoop, strInsertValue)
If pList.Contains(strComposed) = False Then
pList.Add(strComposed)
'Call the same function to review any sub-permutations.
Append(strComposed, pList)
End If
Next
Next
Next
End Sub
End Module
Without actually creating a project to run this code, nor knowing how it 'doesn't accept' long words, my answer would be that there are a lot of permutations for long words and your program is just taking much longer than you're expecting to run. So you probably think it has crashed.
UPDATE:
The problem is the recursion, it's blowing up the stack. You'll have to rewrite your code to use an iteration instead of recursion. Generally explained here
http://www.refactoring.com/catalog/replaceRecursionWithIteration.html
Psuedo code here uses iteration instead of recursion
Generate list of all possible permutations of a string
How to make a style as a bookmark in word 2010?
You won't be able to use most of the text in the document as the bookmark name. It is just illegal to use certain characters in a bookmark name in Word/VBA. It may be possible to add such characters in bookmark names in an XML format of the document, so if it is required, you can ask a separate question.
This feels like way too much code to post on SO. You really need to explain what framework you have in place and tell us where your hurdles are. We can't do this again. "Works for me". If you have any questions though don't hesitate to ask.
Run the "RunMe" macro at the bottom.
Private Function IsParagraphStyledWithHeading(para As Paragraph) As Boolean
Dim flag As Boolean: flag = False
If InStr(1, para.Style, "heading", vbTextCompare) > 0 Then
flag = True
End If
IsParagraphStyledWithHeading = flag
End Function
Private Function GetTextRangeOfStyledParagraph(para As Paragraph) As String
Dim textOfRange As String: textOfRange = para.Range.Text
GetTextRangeOfStyledParagraph = textOfRange
End Function
Private Function BookmarkNameAlreadyExist(bookmarkName As String) As Boolean
Dim bookmark As bookmark
Dim flag As Boolean: flag = False
For Each bookmark In ActiveDocument.Bookmarks
If bookmarkName = bookmark.name Then
flag = True
End If
Next
BookmarkNameAlreadyExist = flag
End Function
Private Function CreateUniqueBookmarkName(bookmarkName As String)
Dim uniqueBookmarkName As String
Dim guid As String: guid = Mid$(CreateObject("Scriptlet.TypeLib").guid, 2, 36)
guid = Replace(guid, "-", "", , , vbTextCompare)
uniqueBookmarkName = bookmarkName & guid
CreateUniqueBookmarkName = uniqueBookmarkName
End Function
Private Function BookmarkIt(rng As Range, bookmarkName As String)
Dim cleanName As String: cleanName = MakeValidBMName(bookmarkName)
If BookmarkNameAlreadyExist(cleanName) Then
cleanName = CreateUniqueBookmarkName(cleanName)
End If
ActiveDocument.Bookmarks.Add name:=cleanName, Range:=rng
End Function
''shamelessly stolen from gmaxey at http://www.vbaexpress.com/forum/showthread.php?t=37674
Private Function MakeValidBMName(strIn As String)
Dim pFirstChr As String
Dim i As Long
Dim tempStr As String
strIn = Trim(strIn)
pFirstChr = Left(strIn, 1)
If Not pFirstChr Like "[A-Za-z]" Then
strIn = "A_" & strIn
End If
For i = 1 To Len(strIn)
Select Case Asc(Mid$(strIn, i, 1))
Case 49 To 58, 65 To 90, 97 To 122
tempStr = tempStr & Mid$(strIn, i, 1)
Case Else
tempStr = tempStr & "_"
End Select
Next i
tempStr = Replace(tempStr, " ", " ")
MakeValidBMName = tempStr
End Function
Sub RunMe()
Dim para As Paragraph
Dim textOfPara As String
For Each para In ActiveDocument.Paragraphs
If IsParagraphStyledWithHeading(para) Then
textOfPara = GetTextRangeOfStyledParagraph(para)
If para.Range.Bookmarks.Count < 1 Then
BookmarkIt para.Range, textOfPara
End If
End If
Next
End Sub