I want to separate text at all the full stops
On Thu, 15 Jan 2009 13:21:27 -0500, Ron Rosenfeld
wrote:
On Thu, 15 Jan 2009 16:10:09 -0000, "Michelle"
wrote:
I know I can do this with text-to-columns, but I may have more than 256
strings in my text-file seperated by full stops, and I can't always use
2007.
What I need is a kind of 'Text-to-Rows' feature, so that it puts each string
into the next cell down
Is there an easy way to do this?
M
This does literally what you request:
=================================
Option Explicit
Sub TextToRows()
Dim c As Range
Dim i As Long
Dim re As Object, mc As Object, m As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "[^.]+"
For Each c In Selection 'or however you set up
'the range to process
If re.test(c.Value) = True Then
i = 2
Set mc = re.Execute(c.Value)
For Each m In mc
c(i, 1).Value = m.Value
i = i + 1
Next m
End If
Next c
End Sub
==================================
This is a little cleaner as it strips off the leading <space's that may be
between the "." and the next word:
================================
Option Explicit
Sub TextToRows()
Dim c As Range
Dim i As Long
Dim re As Object, mc As Object, m As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "[^.]+"
For Each c In Selection 'or however you set up
'the range to process
If re.test(c.Value) = True Then
i = 2
Set mc = re.Execute(c.Value)
For Each m In mc
c(i, 1).Value = Trim(m.Value)
i = i + 1
Next m
End If
Next c
End Sub
===============================
--ron
One other variation, if you prefer, retains the trailing "." at the end of the
sentences. (The Text to columns, using "." as a delimiter, would not, so I did
not do that initially). This also will not return any <space's at the start
of the string (equivalent to the TRIM function in the above).
=========================================
Option Explicit
Sub TextToRows()
Dim c As Range
Dim i As Long
Dim re As Object, mc As Object, m As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "[^.\s][^.]+\."
For Each c In Selection 'or however you set up
'the range to process
If re.test(c.Value) = True Then
i = 2
Set mc = re.Execute(c.Value)
For Each m In mc
c(i, 1).Value = m.Value
i = i + 1
Next m
End If
Next c
End Sub
===========================================
--ron
|