Hi All,
I have text similar to the following, which is an in-house language.
----------------------------------------------
field b831 B831 write AASLQ0300000l;
PCPACIMTAAABl [B29 ]
field B7 b7 ;
field a8 @latestdate(quot;PCP2EHSEAAAAhquot;, jEnd);
field b8 @if(a8 lt;jStart, @latest(quot;PCP2EHSEAAAAhquot;, jEnd),
@avg(quot;PCP2EHSEAAAAhquot;, jStart, jEnd));
--------------------------------------------------------
I want to look through this text and copy out any 13 character codes that
are present (e.g. quot;PCPACIMTAAABlquot; ,2 quot;PCP2EHSEAAAAhquot;).
These codes all share the following characteristics,
1) they are all 13 characters in length
2) the last character in the code is always either a quot;lquot;, quot;hquot; or a quot;cquot;.
3) they contrain no spaces
4) the first 12 characters are always in CAPS (followed by a lower quot;lquot;, quot;hquot;
or a quot;cquot;.
Any help at all will be much appreciated. If you need more explanation,
please ask and I will be happily explain things further.
Regards,
Bhupinder.
In a module, paste following code:
'-------
Dim re As RegExp
Sub initre()
Set re = New RegExp
re.Pattern = quot;([A-Z0-9]{12}[lhc])quot;
re.Global = True
re.IgnoreCase = False
End Sub
Sub FindAndStoreStrings()
Dim i As Long
Dim rSearchArea As Range
Dim rSearch As Range
Dim rDestArea As Range
Dim mc As MatchCollection
Set rSearchArea = Worksheets(quot;Sheet1quot;).Range(quot;A1:A8quot;)
Set rDestArea = Worksheets(quot;Sheet1quot;).Range(quot;B1quot;)
For Each rSearch In rSearchArea
Set mc = re.Execute(rSearch.Text)
For i = 0 To mc.Count - 1
rDestArea.Value = mc(i).Value
Set rDestArea = rDestArea.Offset(1, 0)
Next i
Next rSearch
End Sub
'---------
In ThisWorkBook code, paste the following
'-----------
Private Sub Workbook_Open()
Call initre
End Sub
'---------
Run macro FindAndStoreStrings
HTH
--
APquot;Bhupinder Rayatquot; gt; a écrit dans le
message de ...
gt; Hi All,
gt;
gt; I have text similar to the following, which is an in-house language.
gt; ----------------------------------------------
gt; field b831 B831 write AASLQ0300000l;
gt;
gt; PCPACIMTAAABl [B29 ]
gt;
gt; field B7 b7 ;
gt; field a8 @latestdate(quot;PCP2EHSEAAAAhquot;, jEnd);
gt; field b8 @if(a8 lt;jStart, @latest(quot;PCP2EHSEAAAAhquot;, jEnd),
gt; @avg(quot;PCP2EHSEAAAAhquot;, jStart, jEnd));
gt; --------------------------------------------------------
gt;
gt; I want to look through this text and copy out any 13 character codes that
gt; are present (e.g. quot;PCPACIMTAAABlquot; ,2 quot;PCP2EHSEAAAAhquot;).
gt;
gt; These codes all share the following characteristics,
gt;
gt; 1) they are all 13 characters in length
gt; 2) the last character in the code is always either a quot;lquot;, quot;hquot; or a quot;cquot;.
gt; 3) they contrain no spaces
gt; 4) the first 12 characters are always in CAPS (followed by a lower quot;lquot;,
quot;hquot;
gt; or a quot;cquot;.
gt;
gt; Any help at all will be much appreciated. If you need more explanation,
gt; please ask and I will be happily explain things further.
gt;
gt; Regards,
gt;
gt; Bhupinder.
On Wed, 26 Apr 2006 01:51:01 -0700, Bhupinder Rayat
gt; wrote:
gt; Hi All,
gt;
gt;I have text similar to the following, which is an in-house language.
gt;----------------------------------------------
gt;field b831 B831 write AASLQ0300000l;
gt;
gt;PCPACIMTAAABl [B29 ]
gt;
gt;field B7 b7 ;
gt;field a8 @latestdate(quot;PCP2EHSEAAAAhquot;, jEnd);
gt;field b8 @if(a8 lt;jStart, @latest(quot;PCP2EHSEAAAAhquot;, jEnd),
gt;@avg(quot;PCP2EHSEAAAAhquot;, jStart, jEnd));
gt;--------------------------------------------------------
gt;
gt;I want to look through this text and copy out any 13 character codes that
gt;are present (e.g. quot;PCPACIMTAAABlquot; ,2 quot;PCP2EHSEAAAAhquot;).
gt;
gt;These codes all share the following characteristics,
gt;
gt;1) they are all 13 characters in length
gt;2) the last character in the code is always either a quot;lquot;, quot;hquot; or a quot;cquot;.
gt;3) they contrain no spaces
gt;4) the first 12 characters are always in CAPS (followed by a lower quot;lquot;, quot;hquot;
gt;or a quot;cquot;.
gt;
gt;Any help at all will be much appreciated. If you need more explanation,
gt;please ask and I will be happily explain things further.
gt;
gt;Regards,
gt;
gt;Bhupinder.
This can be done fairly simply with regular expressions. If your total string
lengths are lt;= 255, then download and install Longre's free morefunc.xll add-in
from xcell05.free.fr/
Use the formula:
=REGEX.MID(A1,quot;\b\w{12}(1|h|c)\bquot;)
If there could be multiple matching codes in the same string, there is an
optional third argument in the function to select the instance (and it returns
a null string if there is none).
If your string lengths might be greater than 255, you can use Microsoft
VBScript Regular Expressions and write a UDF to do the same thing.--ron
Hi Ardus,
I am getting error messages saying quot;User-defined Type not defined.
It doesn't like Dim re As RegExp, Set re = New RegExp and Dim mc As
MatchCollection.
Also, shouldn't the first dim statement be within a module? I tried but same
problem.
Thanks,
Bhupinder.
quot;Ardus Petusquot; wrote:
gt; In a module, paste following code:
gt; '-------
gt; Dim re As RegExp
gt;
gt; Sub initre()
gt; Set re = New RegExp
gt; re.Pattern = quot;([A-Z0-9]{12}[lhc])quot;
gt; re.Global = True
gt; re.IgnoreCase = False
gt; End Sub
gt;
gt; Sub FindAndStoreStrings()
gt; Dim i As Long
gt; Dim rSearchArea As Range
gt; Dim rSearch As Range
gt; Dim rDestArea As Range
gt; Dim mc As MatchCollection
gt; Set rSearchArea = Worksheets(quot;Sheet1quot;).Range(quot;A1:A8quot;)
gt; Set rDestArea = Worksheets(quot;Sheet1quot;).Range(quot;B1quot;)
gt; For Each rSearch In rSearchArea
gt; Set mc = re.Execute(rSearch.Text)
gt; For i = 0 To mc.Count - 1
gt; rDestArea.Value = mc(i).Value
gt; Set rDestArea = rDestArea.Offset(1, 0)
gt; Next i
gt; Next rSearch
gt; End Sub
gt; '---------
gt;
gt; In ThisWorkBook code, paste the following
gt; '-----------
gt; Private Sub Workbook_Open()
gt; Call initre
gt; End Sub
gt; '---------
gt;
gt; Run macro FindAndStoreStrings
gt;
gt; HTH
gt; --
gt; AP
gt;
gt;
gt; quot;Bhupinder Rayatquot; gt; a écrit dans le
gt; message de ...
gt; gt; Hi All,
gt; gt;
gt; gt; I have text similar to the following, which is an in-house language.
gt; gt; ----------------------------------------------
gt; gt; field b831 B831 write AASLQ0300000l;
gt; gt;
gt; gt; PCPACIMTAAABl [B29 ]
gt; gt;
gt; gt; field B7 b7 ;
gt; gt; field a8 @latestdate(quot;PCP2EHSEAAAAhquot;, jEnd);
gt; gt; field b8 @if(a8 lt;jStart, @latest(quot;PCP2EHSEAAAAhquot;, jEnd),
gt; gt; @avg(quot;PCP2EHSEAAAAhquot;, jStart, jEnd));
gt; gt; --------------------------------------------------------
gt; gt;
gt; gt; I want to look through this text and copy out any 13 character codes that
gt; gt; are present (e.g. quot;PCPACIMTAAABlquot; ,2 quot;PCP2EHSEAAAAhquot;).
gt; gt;
gt; gt; These codes all share the following characteristics,
gt; gt;
gt; gt; 1) they are all 13 characters in length
gt; gt; 2) the last character in the code is always either a quot;lquot;, quot;hquot; or a quot;cquot;.
gt; gt; 3) they contrain no spaces
gt; gt; 4) the first 12 characters are always in CAPS (followed by a lower quot;lquot;,
gt; quot;hquot;
gt; gt; or a quot;cquot;.
gt; gt;
gt; gt; Any help at all will be much appreciated. If you need more explanation,
gt; gt; please ask and I will be happily explain things further.
gt; gt;
gt; gt; Regards,
gt; gt;
gt; gt; Bhupinder.
gt;
gt;
gt;
Hi Ron,
wow thats impressive!
Thank you for opening up the world of RegEx to me, I can certainly utilise
it and create little programs that will help my team greatly!
Still couldn't get Ardus's code to compile though. I even used createObject
and linked to vbscript, and it then recognised the RegExp command, but it
still didn't like the MatchCollection command. Any Ideas?
Thank you for your help.
Bhupinder
quot;Ron Rosenfeldquot; wrote:
gt; On Wed, 26 Apr 2006 01:51:01 -0700, Bhupinder Rayat
gt; gt; wrote:
gt;
gt; gt; Hi All,
gt; gt;
gt; gt;I have text similar to the following, which is an in-house language.
gt; gt;----------------------------------------------
gt; gt;field b831 B831 write AASLQ0300000l;
gt; gt;
gt; gt;PCPACIMTAAABl [B29 ]
gt; gt;
gt; gt;field B7 b7 ;
gt; gt;field a8 @latestdate(quot;PCP2EHSEAAAAhquot;, jEnd);
gt; gt;field b8 @if(a8 lt;jStart, @latest(quot;PCP2EHSEAAAAhquot;, jEnd),
gt; gt;@avg(quot;PCP2EHSEAAAAhquot;, jStart, jEnd));
gt; gt;--------------------------------------------------------
gt; gt;
gt; gt;I want to look through this text and copy out any 13 character codes that
gt; gt;are present (e.g. quot;PCPACIMTAAABlquot; ,2 quot;PCP2EHSEAAAAhquot;).
gt; gt;
gt; gt;These codes all share the following characteristics,
gt; gt;
gt; gt;1) they are all 13 characters in length
gt; gt;2) the last character in the code is always either a quot;lquot;, quot;hquot; or a quot;cquot;.
gt; gt;3) they contrain no spaces
gt; gt;4) the first 12 characters are always in CAPS (followed by a lower quot;lquot;, quot;hquot;
gt; gt;or a quot;cquot;.
gt; gt;
gt; gt;Any help at all will be much appreciated. If you need more explanation,
gt; gt;please ask and I will be happily explain things further.
gt; gt;
gt; gt;Regards,
gt; gt;
gt; gt;Bhupinder.
gt;
gt; This can be done fairly simply with regular expressions. If your total string
gt; lengths are lt;= 255, then download and install Longre's free morefunc.xll add-in
gt; from xcell05.free.fr/
gt;
gt; Use the formula:
gt;
gt; =REGEX.MID(A1,quot;\b\w{12}(1|h|c)\bquot;)
gt;
gt; If there could be multiple matching codes in the same string, there is an
gt; optional third argument in the function to select the instance (and it returns
gt; a null string if there is none).
gt;
gt; If your string lengths might be greater than 255, you can use Microsoft
gt; VBScript Regular Expressions and write a UDF to do the same thing.
gt;
gt;
gt; --ron
gt;
On Wed, 26 Apr 2006 04:24:01 -0700, Bhupinder Rayat
gt; wrote:
gt;Hi Ron,
gt;
gt;wow thats impressive!
gt;
gt;Thank you for opening up the world of RegEx to me, I can certainly utilise
gt;it and create little programs that will help my team greatly!
gt;
gt;Still couldn't get Ardus's code to compile though. I even used createObject
gt;and linked to vbscript, and it then recognised the RegExp command, but it
gt;still didn't like the MatchCollection command. Any Ideas?
gt;
gt;Thank you for your help.
gt;
gt;Bhupinder
For Ardus's version, you need to set a reference (Tools/References) to
quot;Microsoft VBScript Regular Expressions 5.5quot; which should be in the dropdown
list.--ron
Thanks Ron,
but now it doesnt like Set mc = re.Execute(rSearch.Text), error message says
quot;Object variable or With block variable not setquot;.
Any ideas?
Thanks again,
Bhupinder
quot;Ron Rosenfeldquot; wrote:
gt; On Wed, 26 Apr 2006 04:24:01 -0700, Bhupinder Rayat
gt; gt; wrote:
gt;
gt; gt;Hi Ron,
gt; gt;
gt; gt;wow thats impressive!
gt; gt;
gt; gt;Thank you for opening up the world of RegEx to me, I can certainly utilise
gt; gt;it and create little programs that will help my team greatly!
gt; gt;
gt; gt;Still couldn't get Ardus's code to compile though. I even used createObject
gt; gt;and linked to vbscript, and it then recognised the RegExp command, but it
gt; gt;still didn't like the MatchCollection command. Any Ideas?
gt; gt;
gt; gt;Thank you for your help.
gt; gt;
gt; gt;Bhupinder
gt;
gt; For Ardus's version, you need to set a reference (Tools/References) to
gt; quot;Microsoft VBScript Regular Expressions 5.5quot; which should be in the dropdown
gt; list.
gt;
gt;
gt; --ron
gt;
On Wed, 26 Apr 2006 04:56:02 -0700, Bhupinder Rayat
gt; wrote:
gt;Thanks Ron,
gt;
gt;but now it doesnt like Set mc = re.Execute(rSearch.Text), error message says
gt;quot;Object variable or With block variable not setquot;.
gt;
gt;Any ideas?
gt;
gt;Thanks again,
gt;
gt;Bhupinder
gt;
Well, my first suggestion would be to use Longre's morefunc add-in and the
Regex formulas I posted previously. Morefunc can be easily distributed with a
workbook.
If you must use a VBA solution, then I would use this one, which I wrote myself
so I know it works, and use =REMID(A1,quot;\b\w{12}(1|h|c)\bquot;)
(same pattern but different formula).
Again, if you have multiple codes within the string, there is an optional third
argument to parse out the instance.
And also, you'll have to set the reference to vbscript as I previously wrote.
===============================
Option Explicit
Function REMid(str As String, Pattern As String, _
Optional Index As Variant = 1, _
Optional CaseSensitive As Boolean = True) _
As Variant 'Variant as value may be string or array
Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection
Dim i As Long 'counter
Dim t() As String 'container for array results
' Create a regular expression object.
Set objRegExp = New RegExp
'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern
' Set Case Insensitivity.
objRegExp.IgnoreCase = Not CaseSensitive
'Set global applicability.
objRegExp.Global = True
'Test whether the String can be compared.
If (objRegExp.Test(str) = True) Then
'Get the matches.
Set colMatches = objRegExp.Execute(str) ' Execute search.
On Error Resume Next 'return null string if a colmatch index is non-existent
If IsArray(Index) Then
ReDim t(1 To UBound(Index))
For i = 1 To UBound(Index)
t(i) = colMatches(Index(i) - 1)
Next i
REMid = t()
Else
REMid = CStr(colMatches(Index - 1))
If IsEmpty(REMid) Then REMid = quot;quot;
End If
On Error GoTo 0 'reset error handler
Else
REMid = quot;quot;
End If
End Function
===============================
--ron
Thanks Ron,
Works like a charm. I am very grateful.
Happy coding,
Bhupinder.
quot;Ron Rosenfeldquot; wrote:
gt; On Wed, 26 Apr 2006 04:56:02 -0700, Bhupinder Rayat
gt; gt; wrote:
gt;
gt; gt;Thanks Ron,
gt; gt;
gt; gt;but now it doesnt like Set mc = re.Execute(rSearch.Text), error message says
gt; gt;quot;Object variable or With block variable not setquot;.
gt; gt;
gt; gt;Any ideas?
gt; gt;
gt; gt;Thanks again,
gt; gt;
gt; gt;Bhupinder
gt; gt;
gt;
gt; Well, my first suggestion would be to use Longre's morefunc add-in and the
gt; Regex formulas I posted previously. Morefunc can be easily distributed with a
gt; workbook.
gt;
gt; If you must use a VBA solution, then I would use this one, which I wrote myself
gt; so I know it works, and use =REMID(A1,quot;\b\w{12}(1|h|c)\bquot;)
gt;
gt; (same pattern but different formula).
gt;
gt; Again, if you have multiple codes within the string, there is an optional third
gt; argument to parse out the instance.
gt;
gt; And also, you'll have to set the reference to vbscript as I previously wrote.
gt;
gt; ===============================
gt; Option Explicit
gt; Function REMid(str As String, Pattern As String, _
gt; Optional Index As Variant = 1, _
gt; Optional CaseSensitive As Boolean = True) _
gt; As Variant 'Variant as value may be string or array
gt;
gt; Dim objRegExp As RegExp
gt; Dim objMatch As Match
gt; Dim colMatches As MatchCollection
gt;
gt; Dim i As Long 'counter
gt; Dim t() As String 'container for array results
gt;
gt; ' Create a regular expression object.
gt; Set objRegExp = New RegExp
gt;
gt; 'Set the pattern by using the Pattern property.
gt; objRegExp.Pattern = Pattern
gt;
gt; ' Set Case Insensitivity.
gt; objRegExp.IgnoreCase = Not CaseSensitive
gt;
gt; 'Set global applicability.
gt; objRegExp.Global = True
gt;
gt; 'Test whether the String can be compared.
gt; If (objRegExp.Test(str) = True) Then
gt;
gt; 'Get the matches.
gt; Set colMatches = objRegExp.Execute(str) ' Execute search.
gt;
gt; On Error Resume Next 'return null string if a colmatch index is non-existent
gt; If IsArray(Index) Then
gt; ReDim t(1 To UBound(Index))
gt; For i = 1 To UBound(Index)
gt; t(i) = colMatches(Index(i) - 1)
gt; Next i
gt; REMid = t()
gt; Else
gt; REMid = CStr(colMatches(Index - 1))
gt; If IsEmpty(REMid) Then REMid = quot;quot;
gt; End If
gt; On Error GoTo 0 'reset error handler
gt; Else
gt; REMid = quot;quot;
gt; End If
gt; End Function
gt; ===============================
gt; --ron
gt;
On Thu, 27 Apr 2006 03:10:02 -0700, Bhupinder Rayat
gt; wrote:
gt;Thanks Ron,
gt;
gt;Works like a charm. I am very grateful.
gt;
gt;Happy coding,
Glad to help. Thanks for the feedback.--ron
- Oct 22 Sun 2006 20:09
Searching for codes in text strings
close
全站熱搜
留言列表
發表留言