Text conversions

  • Thread starter Thread starter GerryK
  • Start date Start date
G

GerryK

Hi,
I'd like to create a macro to convert addresses from the
English form to the French format, but I need help.

Examples:
1001 Main Avenue goes to 1001, avenue Main
101 Main Street goes to 100, rue Main
1001 Main Road goes to 100, chemin Main
1001 Main Boulevard goes to 1001, boul Main
101 Main Drive goes to 101, promenade Main

These are the main ones and if there are more conversions
I would add them through the macro logic, if I can figure
it out from these examples.

If I click on a cell A1 (English form address) and then do
a run macro, the result could be placed in B1.

Any thoughts or sites that describe this?

TIA
 
These types of conversions are extremely difficult to do, as it's almost
impossible to cover all the possibilities. How would you treat the following
item?

1001-B Ave. of the Americas

The limited cases that you have provided are easy enough to handle by
briute-force formulas:

=LEFT(A1,FIND(" ",A1)-1)&", "&IF(RIGHT(A1,LEN(A1)-FIND(" ",A1,FIND("
",A1)+1))="Avenue","avenue",IF(RIGHT(A1,LEN(A1)-FIND(" ",A1,FIND("
",A1)+1))="Street","rue",IF(RIGHT(A1,LEN(A1)-FIND(" ",A1,FIND("
",A1)+1))="Boulevard","boul",IF(RIGHT(A1,LEN(A1)-FIND(" ",A1,FIND("
",A1)+1))="Road","chemin",IF(RIGHT(A1,LEN(A1)-FIND(" ",A1,FIND("
",A1)+1))="Drive","promenade")))))&" "&MID(A1,FIND(" ",A1)+1,FIND("
",A1,FIND(" ",A1)+1)-FIND(" ",A1))
 
Hi,

With the following, you select your entries and then invoke the macro. It copies
the result to the cell to the right.

Please note it is far from fullproof especially if you do have more complicated
entries than the ones you specified.

Sub ChgColAText()
Dim C As Range
For Each C In Selection
C(1, 2) = ChgText(C.Value)
Next C
End Sub

Function ChgText(ByVal s$) As Variant
Dim RE As Object, MS As Object
Dim t As String, aStr As Variant, aStrFr As Variant, aRes As Variant

aStr = Array("Avenue", "Street", "Road", "Drive", "Boulevard")
aStrFr = Array("avenue", "rue", "chemin", "promenade", "boul")

t = Join(aStr, "|")
Set RE = CreateObject("VBScript.RegExp")
RE.Ignorecase = True: RE.Global = False
RE.Pattern = "(.*)(" & t & ")"

Set MS = RE.Execute(s)

If MS.Count > 0 Then
t = MS(0).submatches(1)
aRes = Application.Index(aStrFr, Application.Match(t, aStr, 0))
If IsError(aRes) Then
ChgText = CVErr(xlErrNum)
Else
t = MS(0).submatches(0)
ChgText = aRes
aRes = Split(t, " ")
ChgText = Trim(aRes(0) & ", " & ChgText & " " & aRes(1))
End If
Else
ChgText = CVErr(xlErrNum)
End If
Set MS = Nothing: Set RE = Nothing
End Function


Regards,

Daniel M.
 
Daniel.M said:
With the following, you select your entries and then invoke the macro.
It copies the result to the cell to the right.

Please note it is far from fullproof especially if you do have more
complicated entries than the ones you specified.

Sub ChgColAText()
Dim C As Range
For Each C In Selection
C(1, 2) = ChgText(C.Value)
Next C
End Sub

Function ChgText(ByVal s$) As Variant
Dim RE As Object, MS As Object
Dim t As String, aStr As Variant, aStrFr As Variant, aRes As Variant

aStr = Array("Avenue", "Street", "Road", "Drive", "Boulevard")
aStrFr = Array("avenue", "rue", "chemin", "promenade", "boul")

t = Join(aStr, "|")
Set RE = CreateObject("VBScript.RegExp")
RE.Ignorecase = True: RE.Global = False
RE.Pattern = "(.*)(" & t & ")"

Set MS = RE.Execute(s)

If MS.Count > 0 Then
t = MS(0).submatches(1)
aRes = Application.Index(aStrFr, Application.Match(t, aStr, 0))
If IsError(aRes) Then
ChgText = CVErr(xlErrNum)
Else
t = MS(0).submatches(0)
ChgText = aRes
aRes = Split(t, " ")
ChgText = Trim(aRes(0) & ", " & ChgText & " " & aRes(1))
End If
Else
ChgText = CVErr(xlErrNum)
End If
Set MS = Nothing: Set RE = Nothing
End Function
Click to expand...

If you parametrize the function a bit more, it'd be possible to use it just
as a udf and make adapting it to as-yet unspecified alternatives fairly
simple. But using regular expressions as the core of the approach is the
only sound way to do this. That said, spreadsheets aren't ideal for text
processing like this.
 
Harlan,

If you parametrize the function a bit more, it'd be possible to use it just
as a udf and make adapting it to as-yet unspecified alternatives fairly
simple.
Click to expand...

I've seen a Subst() function (pmatch/psub as well) done by yourself that was
close to the specs of the OP but it worked with the Match() collection instead
of the submatches. To be honest, I did not know how to operationalize it with
the request.

In other words, how can you reorder the subexpressions (submatches of the RE
pattern) AND doing some transformation (translation from english to french words
in the OP's case) at the same time?

Regards,

Daniel M.
 
...
...
In other words, how can you reorder the subexpressions (submatches of the RE
pattern) AND doing some transformation (translation from english to french
words in the OP's case) at the same time?
Click to expand...

Not possible. The different translations each require treatment separate from
the reordering of tokens. However, using the defined name xlat referring to

={"Avenue","avenue";"Boulevard","boul";"Drive","promenade";
"Road","chemin";"Street","rue"}

and with "1001 Main Street" in A1, the following formula gives "1001, rue Main".

=subst(A1,"\s*(\d+\S*)\s+(\S+(\s+\S+)*)\s+\S+\s*",
"$1, "&LOOKUP(subst(A1,".+\s+(\S+)\s*","$1"),xlat)&" $2")
 
=subst(A1,"\s*(\d+\S*)\s+(\S+(\s+\S+)*)\s+\S+\s*",
"$1, "&LOOKUP(subst(A1,".+\s+(\S+)\s*","$1"),xlat)&" $2")
Click to expand...

Yes! Putting the translation formula IN the MIDDLE of the replace parameter (2nd
arg of the main subst) does it.

Good stuff. Thanks.

Daniel M.
 
Back
Top