I need help extracting the following highlighted items delimited by REGEX
"delimeter is "YYYYMMDD-YYYYMMDD-CM""
Sub test()
Dim strg, text_string As String
text_string1 = "**mmmmm-02**-20141027-06240105-CM-STATS-HOURLY-DATA-perf.xlsx"
text_string2 = "**mmmm-mmmm-02**-20140811-12010069-CM-HOURLY-STATS-perf.xlsx"
End Sub
Sub test()
Dim text_string1 As String, myResult As String
text_string1 = "**mmmmm-02**-20141027-06240105-CM-STATS-HOURLY-DATA-perf.xlsx"
With CreateObject("VBScript.RegExp") '// Create Regex Engine
.Pattern = "[\d]{8}[\-][\d]{8}[\-]CM" '// Set match pattern
If .Test(text_string1) Then myResult = .Execute(text_string1)(0) '// If found return result.
End With
End Sub
Related
Anybody have a good solution for recursive replace?
For example, you still end up with commas in this string returned by MsgBox:
Dim s As String
s = "32,,,,,,,,,,,,,,,,23"
MsgBox Replace(s, ",,", ",")
I only want one comma.
Here is code that I developed, but it doesn't compile:
Function RecursiveReplace(ByVal StartString As String, ByVal Find As String, ByVal Replace As String) As String
Dim s As String
s = Replace(StartString, Find, Replace)
t = StartString
Do While s <> t
t = s
s = Replace(StartString, Find, Replace)
Loop
RecursiveReplace = s
End Function
The compiler complains about the second line in the function:
s = Replace(StartString, Find, Replace)
It says Expected Array.
???
You can use a regular expression. This shows the basic idea:
Function CondenseCommas(s As String) As String
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Pattern = ",+"
CondenseCommas = RegEx.Replace(s, ",")
End Function
Tested like:
Sub test()
Dim s As String
s = "32,,,,,,,,,,,,,,,,23"
MsgBox CondenseCommas(s)
End Sub
I am making a macro that do a simple replacement in all chart titles. It works very well but suppress all format : italic, bold, ...
Here is the code :
Function trouverItalique(ByRef g As ChartObject)
Dim phrase As String
For i = 0 To Len(g.Chart.ChartTitle.Text)
If InStr(g.Chart.ChartTitle.Characters(i, 1).Font.FontStyle, "Italic") > 0 Then
phrase = phrase & g.Chart.ChartTitle.Characters(i, 1).Text
End If
Next
trouverItalique = phrase
End Function
Private Sub CommandButton1_Click()
Dim char As ChartObject
For Each s In ActiveWorkbook.Worksheets
For Each char In s.ChartObjects
If char.Chart.HasTitle Then
Dim phrase As String
'phrase = trouverItalique(char)
'char.Chart.ChartArea.AutoScaleFont = False
char.Chart.ChartTitle.Characters.Text = replace(char.Chart.ChartTitle.Characters.Text, TextBox1.Text, TextBox2.Text)
Dim index As Integer
'index = InStr(char.Chart.ChartTitle.Characters.Text, phrase)
'char.Chart.ChartTitle.Characters(index, Len(phrase)).Font.Italic = True
End If
Next
Next
End Sub
It works only for some cases and only for to keep the italic, I would like to keep bold and other formats. Do you have an idea to make my code works for any case ? Did I miss a cool mecanism to do the same thing without all of my peregrination ?
Try this:
Sub tester()
ReplaceTitle ActiveSheet.ChartObjects(1).Chart, "ghj", "fffffff"
End Sub
Private Sub ReplaceTitle(cht As Chart, ReplaceWhat As String, ReplaceWith As String)
Dim sTitle As String, pos
If cht.HasTitle Then
pos = InStr(cht.ChartTitle.Characters.Text, ReplaceWhat)
If pos > 0 Then
cht.ChartTitle.Characters(pos, Len(ReplaceWhat)).Text = ReplaceWith
End If
End If
End Sub
How can I split up AB2468123 with excel-vba
I tried something along these lines:
myStr = "AB2468123"
split(myStr, "1" OR "2" OR "3"......."9")
I want to get only alphabet (letters) only.
Thanks.
How about this to retrieve only letters from an input string:
Function GetLettersOnly(str As String) As String
Dim i As Long, letters As String, letter As String
letters = vbNullString
For i = 1 To Len(str)
letter = VBA.Mid$(str, i, 1)
If Asc(LCase(letter)) >= 97 And Asc(LCase(letter)) <= 122 Then
letters = letters + letter
End If
Next
GetLettersOnly = letters
End Function
Sub Test()
Debug.Print GetLettersOnly("abc123") // prints "abc"
Debug.Print GetLettersOnly("ABC123") // prints "ABC"
Debug.Print GetLettersOnly("123") // prints nothing
Debug.Print GetLettersOnly("abc123def") // prints "abcdef"
End Sub
Edit: for completeness (and Chris Neilsen) here is the Regex way:
Function GetLettersOnly(str As String) As String
Dim result As String, objRegEx As Object, match As Object
Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Pattern = "[a-zA-Z]+"
objRegEx.Global = True
objRegEx.IgnoreCase = True
If objRegEx.test(str) Then
Set match = objRegEx.Execute(str)
GetLettersOnly = match(0)
End If
End Function
Sub test()
Debug.Print GetLettersOnly("abc123") //prints "abc"
End Sub
Simpler single shot RegExp
Sub TestIt()
MsgBox CleanStr("AB2468123")
End Sub
Function CleanStr(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "[^a-zA-Z]+"
.Global = True
CleanStr = .Replace(strIn, vbNullString)
End With
End Function
This is what i have found out that works the best. It may be somewhat basic, but it does the job :)
Function Split_String(Optional test As String = "ABC111111") As Variant
For i = 1 To Len(test)
letter = Mid(test, i, 1)
If IsNumeric(letter) = True Then
justletters = Left(test, i - 1)
justnumbers = Right(test, Len(test) - (i - 1))
Exit For
End If
Next
'MsgBox (justnumbers)
'MsgBox (justletters)
'just comment away the answer you want to have :)
'Split_String = justnumbers
'Split_String = justletters
End Function
Possibly the fastest way is to parse a Byte String:
Function alpha(txt As String) As String
Dim b, bytes() As Byte: bytes = txt
For Each b In bytes
If Chr(b) Like "[A-Za-z]" Then alpha = alpha & Chr(b)
Next b
End Function
More information here.
Consider the following VBA Function:
Sub RemoveLetters()
Application.ScreenUpdating = False
Dim str As String: str = "abcdefghijklmnopqrstuvwxyz0123456789 "
Dim ltr As String
For i = 1 To 37
ltr = Mid(str, i, 1)
Sheet9.Range("A2:A1800").Replace _
What:=ltr, Replacement:="", MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next
Application.ScreenUpdating = True
End Sub
This function gets rid of all letter and number characters in a given string. However, the error I encounter is that whenever a string begins with a non-letter, non-number string it fails to execute on that string and does not execute on any further strings. That is, running into such a string stops the execution. Is there an obvious reason why this is happening? How might I modify this code to fix it?
For matching patterns, the best option is regular expressions or more commonly known as regex. By defining a set pattern to follow, you can extract or replace almost anything you want.
To replace all non-number and non-letter characters as well as spaces, a small function like the following works:
Function NoNormalChar(StrTarget As String) As String
Dim oRegEx As Object
Set oRegEx = CreateObject("vbscript.regexp")
With oRegEx
.Pattern = "[a-zA-Z0-9\s]+"
.Global = True
NoNormalChar = .Replace(StrTarget, "")
End With
End Function
Calling it inside a sub is simple enough:
Sub RemoveLetters()
Dim Rng As Range, Cell As Range
Application.ScreenUpdating = False
Set Rng = Sheet9.Range("A2:A1800")
For Each Cell In Rng
Cell.Value = NoNormalChar(Cell.Value)
Next Cell
Application.ScreenUpdating = True
End Sub
Copy and paste both to a single module. Run on a back-up copy and let us know of the results.
If I have a string: "foo, bar" baz, test, blah, how do I remove a specific comma, i.e. not all of them, but just one of my choosing?
with Replace and INSTR it looks like I have not know where the comma is. The problem is, I'll only want to remove the comma if it appears between quotation marks.
So, I may want to remove the first comma and I may not.
Put more clearly, if there is a comma between a set of quotation marks, I need to remove it. if not, then there's nothing to do. But, I can't just remove all the commas, as I need the others in the string.
Try with Regexp in this way:
Sub foo()
Dim TXT As String
TXT = """foo, bar"" baz, test, blah"
Debug.Print TXT
Dim objRegExp As Object
Set objRegExp = CreateObject("vbscript.regexp")
With objRegExp
.Global = True '
.Pattern = "(""\w+)(,)(\s)(\w+"")"
Debug.Print .Replace(TXT, "$1$3$4")
End With
End Sub
It works as expected for the sample value you have provided but could require additional adjustments by changing .Pattern for more complicated text.
EDIT If you want to use this solution as an Excel function than use this code:
Function RemoveCommaInQuotation(TXT As String)
Dim objRegExp As Object
Set objRegExp = CreateObject("vbscript.regexp")
With objRegExp
.Global = True
.Pattern = "(""\w+)(,)(\s)(\w+"")"
RemoveCommaInQuotation = .Replace(TXT, "$1$3$4")
End With
End Function
Ugh. Here's another way
Public Function foobar(yourStr As String) As String
Dim parts() As String
parts = Split(yourStr, Chr(34))
parts(1) = Replace(parts(1), ",", "")
foobar = Join(parts, Chr(34))
End Function
With some error-checking for odd number of double quotes:
Function myremove(mystr As String) As String
Dim sep As String
sep = """"
Dim strspl() As String
strspl = Split(mystr, sep, -1, vbBinaryCompare)
Dim imin As Integer, imax As Integer, nstr As Integer, istr As Integer
imin = LBound(strspl)
imax = UBound(strspl)
nstr = imax - imin
If ((nstr Mod 2) <> 0) Then
myremove = "Odd number of double quotes"
Exit Function
End If
For istr = imin + 1 To imax Step 2
strspl(istr) = Replace(strspl(istr), ",", "")
Next istr
myremove = Join(strspl(), """")
End Function