On 31 Mai, 14:01, Ron Rosenfeld wrote:
On Mon, 31 May 2010 00:36:15 -0700 (PDT), andreashermle
wrote:





Dear Experts:

I got numbers in column C with the following Synthax (xxxxSpacexxx),
e.g.

0250 434 or
0748 314

All these expressions are located in Column C and the 'Space' should
be replaced with an 'Underscore'.
After the replacement the expressions should look like this: 0250_434
or 0748_314

Please note: There are other expressions in cells of column C, such as
192344 / 134374. But those spaces should not be replaced with the
underscore character.

I would like to run a macro for this problem.

Thank you very much in advance for your professional help.

Regards, Andreas

I am assuming from your examples that "xxx" has to be digits, and also that
there is nothing else in the cell. *If that is not the case, the patterns below
can be changed.

=============================
Option Explicit
Sub InsertUnderscore()
* * Dim rg As Range, c As Range
* * Dim s As Variant
* * Set rg = Range("C1")

'find first cell in column C
If Len(rg.Text) = 0 Then Set rg = rg.End(xlDown)
'find last cell in column c and set range
Set rg = Range(rg, rg(Cells.Rows.Count - rg.Row, 1).End(xlUp))

'cycle through range and insert underscore
* * For Each c In rg
* * * * s = c.Text
* * * * If s Like "*# #*" Then
* * * * * * s = Split(s, " ")
* * * * * * If IsNumeric(s(0)) And IsNumeric(s(1)) _
* * * * * * * * * * And UBound(s) = 1 Then
* * * * * * * * c.Value = Join(s, "_")
* * * * * * End If
* * * * End If
* * Next c
End Sub
===========================

This can also be done using Regular Expressions. *The advantage is that the
description of the pattern is simpler and can be easily modified; the
disadvantage is that it will probably run a bit slower.

=================================
Option Explicit
Sub InsertUnderscoreRE()
*Dim rg As Range, c As Range
*Dim re As Object
* * Set rg = Range("C1")

'find first cell in column C
If Len(rg.Text) = 0 Then Set rg = rg.End(xlDown)
'find last cell in column c and set range
Set rg = Range(rg, rg(Cells.Rows.Count - rg.Row, 1).End(xlUp))

'set regex
* * Set re = CreateObject("vbscript.regexp")
* * * * re.Global = True
* * * * re.Pattern = "^(\d+)\s(\d+)$"
'cycle through range and insert underscore
* * For Each c In rg
* * * * c.Value = re.Replace(c.Value, "$1_$2")
* * Next c
End Sub
=============================
--ron- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

Hi Ron,

as always from your side. Nice coding that works just fine. I really
appreciate your superb support. Thank you very much.

Regards, Andreas