wordString --> Word for fill in the blank.
key-->Character is replaced.
I have also have the position of the key in keyPos which is calculated randomly
I'm making a fill in the blanks game. Here I need to create blanks at random position. I'm using Replace(wordString, key, "_", , 1)
But this only replace the first occurrence. If my wordString has repeating letters like APPLE it will always replace the first P
I want to replace the second P also. Like AP_LE.
I got another solution myself.
It has 3 text boxes txtInput, txtOutput, txtKeyPos and a command button command1
Code:
Private Sub Command1_Click()
t1 = Left$(txtInput.Text, Int(txtKeyPos.Text) - 1)
t2 = Right$(txtInput.Text, (Len(txtInput.Text)) - Int(txtKeyPos.Text))
txtOutput.Text = t1 & "_" & t2
End Sub
This serves my purpose.
OK this is vb.net and not vb6 but here goes::
You should do a word approach instead of a character approach:
Dim sentence as String = "My apple is red."
Dim wordsInSentence() as String = sentence.Split()
Dim Rnd as new Random
Dim wordToBlank as String = wordsInSentence(Rnd.next(0, wordsInSentence.length))
Dim blankedSentence as String = sentence.Replace(wordToBlank, "___")
And blankedSentence will contain your sentence with a random word blanked.
My ___ is red.
EDIT: To instead blank a random character in your string, randomise a character index in your string and (if it's not a space) blank that :
Dim sentence as String = "My apple is red."
Dim Rnd as new Random
Dim index As single = Rnd.next(0, sentence.length)
While sentence.Substring(index,1) = " "
index = Rnd.next(0, sentence.length)
End While
Dim blankedSentence as String = sentence.Remove(index,1).Insert(index, "_")
And blankedSentence contains your sentence with a random non-space letter blanked:
My ap_le is red.
This isn't a very good approach though as all letters of all words, including punctuation, can be the character that is blanked. Other than that it will get you what you wanted.
VB6 version:
Dim sentence as String
Dim index As Integer
Dim intUpperBound As Integer
Dim intLowerBound As Integer
sentence = "My apple is red."
intLowerBound = 1 'assuming the first character of the word
intUpperBound = Len(sentence)
Randomize 'initialize the random number generator
index = Int((intUpperBound - intLowerBound + 1) * Rnd) + intLowerBound
While Mid$(sentence, index, 1) = " "
index = Int((intUpperBound - intLowerBound + 1) * Rnd) + intLowerBound
Wend
Dim blankedSentence As String
blankedSentence = sentence
Mid(blankedSentence, index, 1) = "_" 'replace the current character at index with the new character
Related
I have as input the string in the below format
"[1_5,3,7,1],[1_2,4,1,9],[],[1_1,,4,,,9,2]"
What I need to obtain is the same string but with the number after the _ sorted:
"[1_1,3,5,7],[1_1,2,4,9],[],[1_1,2,4,9,,,]"
Dim tmprequestedArea_selectionAreaIn As String = "[1_5,3,7,1],[1_2,4,1,9],[],[1_1,,4,,,9,2]"
tmprequestedArea_selectionAreaIn = Regex.Replace(requestedArea_selectionAreaIn,"\],\[","#")
tmprequestedArea_selectionAreaIn = Regex.Replace(tmprequestedArea_selectionAreaIn,"\[|\]","")
bracList.AddRange(tmprequestedArea_selectionAreaIn.Split(New Char() {"#"c}, StringSplitOptions.None ))
If sortNumber Then
'Split braclist by _ and puts the value in strList
'If after _ is only one number put only that number, else split it by char "," and put in strList the join of the split by , array
'Sort the array
'in previous example strList will contain a,b,c in position 0 and _d_f (instead of f,d) in position 1
For i As Integer = 0 To bracList.Count -1
Dim tmp As String()
Dim tmpInt As New System.Collections.Generic.List(Of Integer)
If Not(String.IsNullOrEmpty(bracList(i))) Then
Dim tmpRequested As String = bracList(i).Split(New Char() {"_"c})(0)
Dim tmpSelection As String = bracList(i).Split(New Char() {"_"c})(1)
If tmpSelection.Contains(",") Then
tmp = tmpSelection.Split(New Char() {","c})
For j As Integer = 0 To tmp.Length -1
tmpInt.Add(Convert.toInt32(tmp(j)))
Next
tmpInt.Sort
strList.Add("[" + tmpRequested + "_" + String.Join(",",tmpInt ) + "]")
Else
strList.Add("[" + tmpRequested + "_" + tmpSelection + "]" )
End If
Else
strList.Add("[]")
End If
Next i
I'm looking for a better way to manage it.
Try this, as a possible substitute for what you're doing now.
Given this input string:
Dim input As String = "[1_5,3,7,1],[1_2,4,1,9],[],[1_1,,4,,,9,2]"
Note: this will also deal with decimal values without changes. E.g.,
"[1_5.5,3.5,7,1],[1_2.564,4,2.563,9],[],[1_1,,4.23,,,9.0,2.45]"
You can extract the content of the brackets with this pattern: \[(.*?)\] and use Regex.Matches to return a MatchCollection of all the substrings that match the pattern.
Then use a StringBuilder as a container to rebuild the string while the parts are being treated.
Imports System.Linq
Imports System.Text.RegularExpressions
Dim pattern As String = "\[(.*?)\]"
Dim matches = Regex.Matches(input, pattern, RegexOptions.Singleline)
Dim sb As New StringBuilder()
For Each match As Match In matches
Dim value As String = match.Groups(1).Value
If String.IsNullOrEmpty(value) Then
sb.Append("[],")
Continue For
End If
Dim sepPosition As Integer = value.IndexOf("_"c) + 1
sb.Append("[" & value.Substring(0, sepPosition))
Dim values = value.Substring(sepPosition).Split(","c)
sb.Append(String.Join(",", values.Where(Function(n) n.Length > 0).OrderBy(Function(n) CDec(n))))
sb.Append(","c, values.Count(Function(n) n.Length = 0))
sb.Append("],")
Next
Dim result As String = sb.ToString().TrimEnd(","c)
If you don't know about LINQ, this is what it's doing:
String.Join(",", values.Where(Function(n) n.Length > 0).OrderBy(Function(n) CDec(n)))
values is an array of strings, generated by String.Split().
values.Where(Function(n) n.Length > 0): creates an Enumerable(Of String) from values Where the content, n, is a string of length > 0.
I could have written values.Where(Function(n) Not String.IsNUllOrEmpty(n)).
.OrderBy(Function(n) CDec(n))): Orders the resulting Enumerable(Of String) using the string value converted to Decimal and generates an Enumerable(Of String), which is passed back to String.Join(), to rebuild the string, adding a char (","c) between the parts.
values.Count(Function(n) n.Length = 0): Counts the elements of values that have Length = 0 (empty strings). This is the number of empty elements that are represented by a comma, appended at the end of the partial string.
If you are looking for a "way"
I think it is easier to fetch each char of the string and if it is a number you put it in array (and when the char is ']' you start new array) the sort the arrays and replace each number from the string with it's sorted number (so you will just do allocation without the need to reconstruct with regular expression
I wish that I had Visual Studio to provide you the code (it is joyful to code a riddle) ^_^
ps:for the commas you can use a counter for each blank commas an the put it in the end
Need some help writing a regular expression to count the number of words in a string (Please note the data is a html string, which needs to be placed into a spreadsheet) when separated either by any special characters like . , - , +, /, Tab etc. Count should exclude special characters.
**Original String** **End Result**
Ex : One -> 1
One. -> 1
One Two -> 2
One.Two -> 2
One Two. -> 2
One.Two. -> 2
One.Tw.o -> 3
Updated
I think you asked a valuable question and this downvoting is not fair!
Function WCount(ByVal strWrd As String) As Long
'Variable declaration
Dim Delimiters() As Variant
Dim Delimiter As Variant
'Initialization
Delimiters = Array("+", "-", ".", "/", Chr(13), Chr(9)) 'Define your delimiter characters here.
'Core
For Each Delimiter In Delimiters
strWrd = Replace(strWrd, Delimiter, " ")
Next Delimiter
strWrd = Trim(strWrd)
Do While InStr(1, strWrd, " ") > 0
strWrd = Replace(strWrd, " ", " ")
Loop
WCount = UBound(Split(strWrd, " ")) + 1
End Function
________________
You can use this function as a UDF in excel formulas or can use in another VBA codes.
Using in formula
=WCOUNT("One.Two.Three.") or =WCOUNT($A$1") assuming your string is in A1 cell.
Using in VBA
(With assume passing your string with Str argument.)
Sub test()
Debug.Print WCount(Str)
End Sub
Regards.
Update
I have test your text as shown below.
copy your text in a Cell of Excel as shown.
The code updated for Line break and Tab characters and count your string words correctly now.
Try this code, all necessary comments are in code:
Sub SpecialSplit()
Dim i As Long
Dim str As String
Dim arr() As String
Dim delimeters() As String
'here you define all special delimeters you want to use
delimetres = Array(".", "+", "-", "/")
For i = 1 To 9
str = Cells(i, 1).Value
'this will protect us from situation where last character is delimeter and we have additional empty string
str = Left(str, Len(str) - 1)
'here we replace all special delimeters with space to simplify
For Each delimeter In delimetres
str = Replace(str, delimeter, " ")
Next
arr = Split(str)
Cells(i, 2).Value = UBound(arr) - LBound(arr) + 1
Next
End Sub
With your posted data following RegExp is working correctly. Put this in General Module in Visual Basic Editor.
Public Function CountWords(strInput As String) As Long
Dim objMatches
With CreateObject("VBScript.RegExp")
.Global = True
.MultiLine = True
.Pattern = "\w+"
Set objMatches = .Execute(strInput)
CountWords = objMatches.Count
End With
End Function
You have to use it like a normal formula. e.g. assuming data is in cell A1 function would be:
=CountWords(A1)
For your information, it can be also achieved through formula if number of characters are specific like so:
=LEN(TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(TRIM(A1),"."," "),","," "),"-"," "),"+"," "),"/"," "),"\"," ")))-LEN(SUBSTITUTE(TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(TRIM(A1),"."," "),","," "),"-"," "),"+"," "),"/"," "),"\"," "))," ",""))+1
Edit:
Since my string became more and more complicated looks like regexp is the only way.
I do not have a lot experience in that and your help is much appreciated.
Basically from what I read on the web I construct the following exp to try matching occurrence in my sample string:
"My very long long string 12Mar2012 is right here 23Apr2015"
[0-9][0-9] + [a-zA-Z] + [0-9][0-9][0-9][0-9]
and trying this code. I do not have any match. Any good link on regexp tutorial much appreciated.
Dim re, match, RegExDate
Set re = CreateObject("vbscript.regexp")
re.Pattern = "(^[0-9][0-9] + [a-zA-Z] + [0-9][0-9][0-9][0-9]$)"
re.Global = True
For Each match In re.Execute(str)
MsgBox match.Value
RegExDate = match.Value
Exit For
Next
Thank you
This code validates the actual date from the Regexp using DateValuefor robustness
Sub Robust()
Dim Regex As Object
Dim RegexMC As Object
Dim RegexM As Object
Dim strIn As String
Dim BDate As Boolean
strIn = "My very long long string 12Mar2012 is right here 23Apr2015 and 30Feb2002"
Set Regex = CreateObject("vbscript.regexp")
With Regex
.Pattern = "(([0-9])|([0-2][0-9])|([3][0-1]))(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)(\d{4})"
.Global = True
If .test(strIn) Then
Set RegexMC = .Execute(strIn)
On Error Resume Next
For Each RegexM In RegexMC
BDate = False
BDate = IsDate(DateValue(RegexM.submatches(0) & " " & RegexM.submatches(4) & " " & RegexM.submatches(5)))
If BDate Then Debug.Print RegexM
Next
On Error GoTo 0
End If
End With
End Sub
thanks for all your help !!!
I managed to solve my problem using this simple code.
Dim rex As New RegExp
Dim dateCol As New Collection
rex.Pattern = "(\d|\d\d)(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)(\d{4})?"
rex.Global = True
For Each match In rex.Execute(sStream)
dateCol.Add match.Value
Next
Just note that on my side I'm sure that I got valid date in the string so the reg expression is easy.
thnx
Ilya
The following is a quick attempt I made. It's far from perfect.
Basically, it splits the string into words. While looping through the words it cuts off any punctuation (period and comma, you might need to add more).
When processing an item, we try to remove each month name from it. If the string gets shorter we might have a date.
It checks to see if the length of the final string is about right (5 or 6 characters, 1 or 2 + 4 for day and year)
You could instead (or also) check to see that there all numbers.
Private Const MonthList = "JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC"
Public Function getDates(ByVal Target As String) As String
Dim Data() As String
Dim Item As String
Dim Index As Integer
Dim List() As String
Dim Index2 As Integer
Dim Test As String
Dim Result As String
List = Split(MonthList, ",")
Data = Split(Target, " ")
Result = ""
For Index = LBound(Data) To UBound(Data)
Item = UCase(Replace(Replace(Data(Index), ".", ""), ",", ""))
For Index2 = LBound(Data) To UBound(Data)
Test = Replace(Item, List(Index2), "")
If Not Test = Item Then
If Len(Test) = 5 Or Len(Test) = 6 Then
If Result = "" Then
Result = Item
Else
Result = Result & ", " & Item
End If
End If
End If
Next Index2
Next
getDates = Result
End Function
I want to select a random space in a string and replace it with a word (%word%) but there is a problem. The position cannot be fixed as i want it to be inserted at a random break. Few things which iam considering :
1)break the string at a space and merge it with the word
2) find a random space and replace it with the word. I like this point and so far all i have is break the selectedtext into string array and then iterate over each line. But i don't know how to find a random string position? Any short and sweet code please?
If (rtfArticle.SelectedText.Length > 0) Then
Dim strArray As String() = rtfArticle.SelectedText.Split(New Char() {ChrW(10)})
For Each str3 As String In strArray
If (str3.Contains(" ") = True) Then
End If
Next
End If
You could use the Random class to generate a random position index.
Dim testString = "This is just a test for random position"
Dim random = New Random()
Dim randomPos = random.Next(0, testString.Length - 1)
Debug.Print(String.Format("Char at Pos {0} = {1}", randomPos, testString.ElementAt(randomPos)))
You could locate the spaces in the string, pick one by random, and replace it. Something like:
' Get string
Dim data As String = rtfArticle.SelectedText
' Get space positions
Dim spaces As New List(Of Integer)
For i As Integer = 0 to data.Length - 1
If data(i) = " "C Then spaces.Add(i)
Next
' Get a random space
Dim rnd As New Random()
Dim pos As Integer = spaces(rnd.Next(spaces.Length))
' Remove the space
data = data.Remove(pos, 1)
' Insert the replacement
data = data.Insert(pos, "%word%")
' Put the string back
rtfArticle.SelectedText = data
I need to
a) separate strings from numbers for a selection of cells
and
b) place the separated strings and numbers into different columns.
For example , Excel sheet is as follows:
A1 B1
100CASH etc.etc.
The result should be:
A1 B1 C1
100 CASH etc.etc.
Utilization of regular expressions will be useful, as there may be different cell formats,such as 100-CASH, 100/CASH, 100%CASH. Once the procedure is set up it won't be hard to use regular expressions for different variations.
I came across a UDF for extracting numbers from a cell. This can easily be modified to extract string or other types of data from cells simply changing the regular expression.
But what I need is not just a UDF but a sub procedure to split cells using regular expressions and place the separated data into separate columns.
I've also found a similar question in SU, however it isn't VBA.
See if this will work for you:
UPDATED 11/30:
Sub test()
Dim RegEx As Object
Dim strTest As String
Dim ThisCell As Range
Dim Matches As Object
Dim strNumber As String
Dim strText As String
Dim i As Integer
Dim CurrCol As Integer
Set RegEx = CreateObject("VBScript.RegExp")
' may need to be tweaked
RegEx.Pattern = "-?\d+"
' Get the current column
CurrCol = ActiveCell.Column
Dim lngLastRow As Long
lngLastRow = Cells(1, CurrCol).End(xlDown).Row
' add a new column & shift column 2 to the right
Columns(CurrCol + 1).Insert Shift:=xlToRight
For i = 1 To lngLastRow ' change to number of rows to search
Set ThisCell = ActiveSheet.Cells(i, CurrCol)
strTest = ThisCell.Value
If RegEx.test(strTest) Then
Set Matches = RegEx.Execute(strTest)
strNumber = CStr(Matches(0))
strText = Mid(strTest, Len(strNumber) + 1)
' replace original cell with number only portion
ThisCell.Value = strNumber
' replace cell to the right with string portion
ThisCell.Offset(0, 1).Value = strText
End If
Next
Set RegEx = Nothing
End Sub
How about:
Sub UpdateCells()
Dim rng As Range
Dim c As Range
Dim l As Long
Dim s As String, a As String, b As String
''Working with sheet1 and column C
With Sheet1
l = .Range("C" & .Rows.Count).End(xlUp).Row
Set rng = .Range("C1:C" & l)
End With
''Working with selected range from above
For Each c In rng.Cells
If c <> vbNullString Then
s = FirstNonNumeric(c.Value)
''Split the string into numeric and non-numeric, based
''on the position of first non-numeric, obtained above.
a = Mid(c.Value, 1, InStr(c.Value, s) - 1)
b = Mid(c.Value, InStr(c.Value, s))
''Put the two values on the sheet in positions one and two
''columns further along than the test column. The offset
''can be any suitable value.
c.Offset(0, 1) = a
c.Offset(0, 2) = b
End If
Next
End Sub
Function FirstNonNumeric(txt As String) As String
With CreateObject("VBScript.RegExp")
.Pattern = "[^0-9]"
FirstNonNumeric = .Execute(txt)(0)
End With
End Function