I am trying to add slashes between characters in a string, e. g. hello -> h/e/l/l/o
I tried to use Replace(string, "", "/") but the String remained unchanged.
Try this:
Sub Main
dim initial_text as string
dim final_text as string
initial_text = "hello"
final_text = ""
Dim i As Integer
For i = 1 To len(initial_text)
if i = len(initial_text) then
final_text = final_text + Mid(initial_text,i,1)
else
final_text = final_text + Mid(initial_text,i,1) + "/"
end if
Next i
msgbox final_text
End Sub
EDIT
For study porpuse, I add another answer based on comments from (The next answer is a good answer too):
Dim s As String
s = "Hello"
#wqw
Debug.Print Left(Replace(StrConv(s, vbUnicode), Chr$(0), "/"), Len(s) * 2 - 1)
#Jeeped
Debug.Print Left(Join(Split(StrConv(s, vbUnicode), Chr$(0)), "/"), Len(s) * 2 - 1)
Here is an emulation of preg_replace function from PHP that I'm using which allows a simple regex to do the job. The look-ahead part gets rid of the last slash too.
Option Explicit
Private Sub Form_Load()
Dim s As String
s = "Hello"
Debug.Print preg_replace("(.)(?=.)", "$1/", s)
End Sub
Public Function preg_replace(sPattern As String, sReplace As String, sText As String) As String
Dim lIdx As Long
With CreateObject("VBScript.RegExp")
.Global = True
If Left$(sPattern, 1) = "/" Then
lIdx = InStrRev(sPattern, "/")
.Pattern = Mid$(sPattern, 2, lIdx - 2)
.IgnoreCase = (InStr(lIdx, sPattern, "i") > 0)
.MultiLine = (InStr(lIdx, sPattern, "m") > 0)
Else
.Pattern = sPattern
End If
preg_replace = .Replace(sText, sReplace)
End With
End Function
Related
I have more than one text with the word "123" inside Textabc
like a123b , c123erf and 123
but I just wanna locate the exact word "123"
Text_u1 = Mid(Textabc, InStr(Text, "123"))
I tried &123& but not working
Thanks
Option Explicit
Sub GetWord()
Dim Textabc As String, s As Variant, i As Variant, abc As String, sz As Long
Dim foundStart As Long, foundLen As Long
Textabc = "like a123b , c123erf and 123"
abc = "123"
s = Split(Textabc)
For i = 0 To UBound(s)
sz = sz + Len(s(i)) + 1
If Trim(s(i)) = abc Then
foundStart = sz - Len(s(i))
foundLen = Len(Textabc) - (sz - Len(s(i))) + 1
Debug.Print "Textabc length: " & Len(Textabc)
Debug.Print "foundStart: " & foundStart
Debug.Print "foundLen: " & foundLen
Debug.Print Mid(Textabc, foundStart, foundLen)
End If
Next
End Sub
Try one of these two, depending on what you want:
Public Sub TestMe()
Debug.Print InStr("a123b", "123")
Debug.Print Mid("a123b", InStr("a123b", "123"))
End Sub
You can try using Regular Expressions
Sub Test()
Dim regEx As Object
Dim str As String
Set regEx = CreateObject("vbscript.RegExp")
str = "a123b , c123erf and 123"
With regEx
.Global = True
.IgnoreCase = True
.Pattern = "\b(123)"
Debug.Print regEx.Execute(str)(0).FirstIndex + 1
End With
End Sub
This will return the position of the first match it finds that is equal to just 123 everything else will be ignored. If there are more then one match you will need to loop over the output of regEx.Execute(str) to get each position
So I have obfuscated date information in my column. e.g. Jan preplan-2017, Feb-afterplan-2017-low, etc.
Two things are always consistent: Months always come in the beginning with 3 letters. And year comes in 4 digits (may in anywhere.)
I basically need them in the standard date format( e.g. 1/1/2017, 1/2/2017, etc.)
First convert your string to a date value:
s = "Jan preplan-2017"
TrueDate = DateValue("1 " & Left(s, 3) & " " & Right(s, 4))
Then - for display - format as required:
ShowDate = Format(TrueDate, "d.m.yyyy")
Or in one go:
ShowDate = Format(DateValue("1 " & Left(s, 3) & " " & Right(s, 4)), "d.m.yyyy")
Edit: Use Split to create an array of the elements, loop these and pick the one that is an integer:
Year = Split("Feb-afterplan-2017-low", "-")(2)
I'm not brilliant with RegEx so no doubt this can be improved.
As a worksheet function:
Public Function ConvertDate(sData As String) As Variant
Dim RE As Object, REMatches As Object
Dim Temp As String
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "\d{4}"
End With
Set REMatches = RE.Execute(sData)
If REMatches.Count > 0 Then
Temp = "1-" & Left(sData, 3) & "-" & REMatches(0)
ConvertDate = CDate(DateValue(Temp))
Else
'Returns #VALUE error on no match.
ConvertDate = CVErr(xlValue)
End If
End Function
Passes date by reference and returns TRUE/FALSE:
Public Sub Test()
Dim MyDate As Date
If ConvertDate1("Jan preplan-2017", MyDate) Then
MsgBox "Date converted to " & Format(MyDate, "dd-mmm-yy"), vbOKOnly
Else
MsgBox "Date not converted.", vbOKOnly
End If
End Sub
Public Function ConvertDate1(sData As String, ByRef ReturnValue As Date) As Boolean
Dim RE As Object, REMatches As Object
Dim Temp As String
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "\d{4}"
End With
Set REMatches = RE.Execute(sData)
If REMatches.Count > 0 Then
Temp = "1-" & Left(sData, 3) & "-" & REMatches(0)
ReturnValue = CDate(DateValue(Temp))
ConvertDate1 = True
Else
ConvertDate1 = False
End If
End Function
The RegEx can be improved to check first three letters are a month... loads can be done to improve, but you get the picture I hope.
How to find the first instance of a "lower case character" in a cell using VBA in Excel?
I have tried using ASCII values but that didn't work.
Try the following small UDF:
Public Function Findlower(rin As Range) As Long
Dim v As String, CH As String, i As Long
Findlower = 0
v = rin.Text
L = Len(v)
For i = 1 To L
If Mid(v, i, 1) Like "[a-z]" Then
Findlower = i
Exit Function
End If
Next i
End Function
It will return the position of the first instance of any lower case letter in a string:
You can use a RegExp in a UDF to avoid looping through each character:
Function FirstLower(strIn As String) as String
Dim objRegex As Object
Dim objRegM As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "[a-z]"
.ignorecase = False
If .test(strIn) Then
Set objRegM = .Execute(strIn)(0)
FirstLower = objRegM.firstindex + 1
Else
FirstLower = "no match"
End If
End With
End Function
I think you want to remove the first part in your string that is in lower case:
Public Function DeletFirstLowerPart(strTemp As String) As String
Dim strResult As String, i As Long, findLower As Boolean
strResult = ""
findLower = False
For i = 1 To Len(strTemp)
If (Mid(strTemp, i, 1) Like "[a-z]") Then
findLower = True
Else
If findLower = True Then
strResult = strResult & Mid(strTemp, i)
DeletFirstLowerPart = strResult
Exit Function
End If
strResult = strResult & Mid(strTemp, i, 1)
End If
Next i
DeletFirstLowerPart = strResult
End Function
DeletFirstLowerPart("ABCdefGHI") = "ABCGHI"
DeletFirstLowerPart("ABCdefGHIjkl") = "ABCGHIjkl"
Private Function DeleteLowerCasesLike(InputString As String) As String
Dim i As Integer
For i = 1 To Len(InputString)
If Mid(InputString, i, 1) Like "[a-z]" Then
InputString = Left(InputString, i - 1) & Mid(InputString, i + 1)
i = i - 1
End If
Next
DeleteLowerCasesLike = InputString
End Function
Another RegExp solution which needs to addig referance to Microsoft VBScript Regular Expressions 1.0 (In the VBA window, Tools->Referances menu)
Private Function DeleteLowerCasesRegExp(InputString As String)
Dim RE As New RegExp
With RE
.Global = True
.IgnoreCase = False
.Pattern = "[a-z]"
DeleteLowerCasesRegExp = .Replace(InputString, "")
End With
End Function
And another solution nor Like neither RegExp is used:
Private Function DeleteLowerCasesAsc(InputString As String) As String
Dim i As Integer
For i = 1 To Len(InputString)
If Mid(InputString, i, 1) = Empty Then Exit For
If Asc(Mid(InputString, i, 1)) >= 97 And Asc(Mid(InputString, i, 1)) <= 122 Then
InputString = Left(InputString, i - 1) & Mid(InputString, i + 1)
i = i - 1
End If
Next
DeleteLowerCasesAsc = InputString
End Function
Another solution in which replace function is used:
Private Function DeleteLowerCasesReplace(InputString As String) As String
Dim i As Integer
For i = 97 To 122
InputString = Replace(InputString, Chr(i), "")
Next
DeleteLowerCasesReplace = InputString
End Function
The code from Get the value between the brackets works well if the cell contains just one "(text)".
Unfortunately, in my rows there are many "Sample (sample1) (sample2)" format sentences and I need the last part.
Function GetParen(strIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "\((.+?)\)"
If .Test(strIn) Then
Set objRegMC = .Execute(strIn)
GetParen = objRegMC(0).submatches(0)
Else
GetParen = "No match"
End If
End With
Set objRegex = Nothing
End Function
Could somebody help me to modify the code? Because if the cell contains "Text (text part1) (text part2)" The result what I get is "text part1" but I need the "text part2".
Thanks.
Why bother with regex ?? Consider the alternative:
Public Function GetParen(strIn As String) As String
Dim gather As Boolean, L As Long, i As Long
Dim CH As String
gather = False
L = Len(strIn)
For i = L To 1 Step -1
CH = Mid(strIn, i, 1)
If gather Then GetParen = CH & GetParen
If CH = ")" Then gather = True
If CH = "(" Then Exit For
Next i
GetParen = Mid(GetParen, 2)
End Function
EDIT#1:
Simpler:
Public Function GetParen2(strIn As String) As String
ary = Split(strIn, "(")
bry = Split(ary(UBound(ary)), ")")
GetParen2 = bry(0)
End Function
tiborjan:
I have a function that I wrote for just that reason. Here it is:
Function SubStr(s1 As String, sLeft As String, sL_Occ As Integer, sRight As String, sR_Occ As Integer) As String
'Cuts a piece of text from between two strings within another string
Dim LeftBound As Integer, RightBound As Integer, i As Integer
If sLeft = "Minimum" Then
LeftBound = 0
Else
For i = 1 To sL_Occ
LeftBound = InStr(LeftBound + 1, s1, sLeft, vbTextCompare)
Next i
End If
LeftBound = LeftBound + Len(sLeft) - 1 'measure from the right of the left bound
If sRight = "Maximum" Then
RightBound = Len(s1) + 1
Else
For i = 1 To sR_Occ
RightBound = InStr(RightBound + 1, s1, sRight, vbTextCompare)
Next i
End If
SubStr = Mid(s1, LeftBound + 1, RightBound - LeftBound - 1)
End Function
It has 5 parameters:
s1: the string that contains the text you want to parse
sLeft: the left-bound of the text you want to parse. Use "(" for your application.
sL_Occ: iteration number of sLeft. So if you wanted the second "(" that appears in s1, make this 2.
sRight: same as sLeft, but the right-bound.
sR_Occ: same as sL_Occ, but referring to the right-bound.
To make it easy: use this function code instead of yours. If you want to pull text from the second set of parentheses, use
s1 = "(P1) (P2) (P3) (P4)"
sLeft = "("
sL_Occ = 2
sRight = ")"
sR_Occ = 2
The return in the above would be "P2".
Hope that helps!
Matt, via ExcelArchitect.com
or how about simply
Function LastParam(ByVal str As String) As String
Dim arr() As String
arr = Split(str, "(")
LastParam = Split(arr(UBound(arr, 1)), ")")(0)
End Function
For completeness, you would only need minor changes to your code to make it work with your regex.
Set the Global flag to True, and return the last match from the match collection.
Function GetParen(strIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "\((.+?)\)"
If .Test(strIn) Then
Set objRegMC = .Execute(strIn)
GetParen = objRegMC(objRegMC.Count - 1).submatches(0)
Else
GetParen = "No match"
End If
End With
Set objRegex = Nothing
End Function
A minor tweak to my earlier Regexpwill extract the last match.
test
Sub Test()
MsgBox GetParen("(Sample (sample1) (sample2)")
End Sub
code
Function GetParen(strIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "\((.+?)\)"
.Global = True
If .Test(strIn) Then
Set objRegMC = .Execute(strIn)
GetParen = objRegMC(objRegMC.Count - 1).submatches(0)
Else
GetParen = "No match"
End If
End With
Set objRegex = Nothing
End Function
this script is going to extract each text between () from whole string. Now i would prepare it as a function because many string will be taking under that then i would like to add each extracted words inside table/or list. Each of extracted texts between () should be without special characters which sometimes could occur inside text and i would like to cut them of the string (i would like only to stay A-Z a-z 0-9 how could i do it all?
Sub Main()
Dim s$
s = "hsus(irt)bla dsd (got)(rifk)"
Debug.Print extract_value(s)
End Sub
Public Function extract_value$(s$)
Dim returnS$
Dim v
v = Split(s, Chr(40))
For Each Item In v
If InStr(Item, Chr(41)) Then
returnS = returnS & Chr(32) & Split(Item, ")")(0)
End If
Next
extract_value = Trim$(returnS)
End Function
When parsing you can use a helper function to check for just letters and numbers using the ASCII encoding.
Function validChr(chr As String) as Boolean
Dim ascCode As Integer
ascCode = Asc(chr)
If ascCode >= 65 And ascCode <= 90 Then 'Uppercase
validChr = True
ElseIf ascCode >= 97 And ascCode <= 122 Then 'Lowercase
validChr = True
ElseIf ascCode >= 48 And ascCode <= 57 Then 'Numbers
validChr = True
Else
validChr = False
End Function
You can also look at using RegEx.
This two stage `Regexp`
Converts hsus(ir%$%^t)bla dsd (g°ot)(rifk) to ir%$%^t g°ot rifk
In a single shot ir%$%^t g°ot rifkto irt got rifk
test sub
Sub Main()
Dim strTest As String
strTest = "hsus(ir%$%^t)bla dsd (g°ot)(rifk)"
MsgBox GrabIt(strTest)
End Sub
main sub
Function GrabIt(strIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Dim objRegM As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "\((.*?)\)"
.Global = True
If .test(strIn) Then
Set objRegMC = .Execute(strIn)
For Each objRegM In objRegMC
GrabIt = GrabIt & Chr(32) & objRegM.submatches(0)
Next
End If
.Pattern = "[^\w|\s]+"
GrabIt = .Replace(GrabIt, vbNullString)
End With
End Function