PDA

View Full Version : Regular Expression - Formatting numbers



rastapopoulo
03-15-2012, 12:27 PM
I'm fairly new to regular expressions. I would like to know how to convert English numbers to French numbers.

English format: $400,040.34
French format: 400 040,34 $

Ideally, I would like my script to work regardless of the number of digits we have:

$1 would change to 1 $
and $500,000,000,000 to 500 000 000 000 $

I would also like it to work with different currencies and with no currencies at all:

€4,000 to 4 000 €
$4,000 to 4 000 $
4,000 to 4 000

I'm assuming I might need different patterns for different currencies, but that's not a problem.

I'd appreciate any help. Thanks.

macropod
03-16-2012, 07:31 PM
Try:
Sub FrenchNumFormat()
Application.ScreenUpdating = False
Dim Rng As Range, StrTmp As String
With ActiveDocument.Range
With .Find
.ClearFormatting
.Text = "[0-9,.]{3,}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
Set Rng = .Duplicate
With Rng
StrTmp = .Text
StrTmp = Replace(Replace(StrTmp, ",", " "), ".", ",")
If .Characters.First.Previous.Text Like "[$€ŁĄ]" Then
.Start = .Start - 1
StrTmp = StrTmp & " " & .Characters.First.Text
End If
.Text = StrTmp
End With
.Start = Rng.End
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

rastapopoulo
03-16-2012, 08:04 PM
Thanks for the nice script.

I think my requirements were a little more complex than I stated. In the attached document, it doesn't quite work for all the numbers. One reason is that in English, there are sometimes spaces between the dollar sign and the following number, or sometimes even a tab (see tables in attached doc). How could I modify the script so it still detects the dollar sign in those cases?

Would if be by adding conditions to the following If statement?


If .Characters.First.Previous.Text Like "[$€ŁĄ]" Then
.Start = .Start - 1
StrTmp = StrTmp & " " & .Characters.First.Text
End If


Also, the script doesn't convert the "$1".

Many thanks!

macropod
03-16-2012, 11:39 PM
Try the following. I've added some comments to explain what the code is doing.
Sub FrenchNumFormat()
Application.ScreenUpdating = False
Dim Rng As Range, StrTmp As String
With ActiveDocument.Range
With .Find
.ClearFormatting
'the find expression is any numeric 'word'
.Text = "<[0-9]@>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
Set Rng = .Duplicate
With Rng
'move our start backwards until all possible valid currency characters are found
While .Characters.First.Previous.Text Like "[" & vbTab & " $€ŁĄ]"
.Start = .Start - 1
Wend
'move our start forwards until all invalid non-currency characters are excluded
While .Characters.First.Text Like "[" & vbTab & " ]"
.Start = .Start + 1
Wend
'move our end forwards until all all possible valid number-format characters are found
While .Characters.Last.Next.Text Like "[0-9,.]"
.End = .End + 1
Wend
'move our end forwards until all punctuation characters are excluded
While .Characters.Last.Text Like "[,.]"
.End = .End - 1
Wend
StrTmp = Replace(Replace(Replace(Replace(.Text, " ", ""), vbTab, ""), ",", " "), ".", ",")
If Left(StrTmp, 1) Like "[$€ŁĄ]" Then _
StrTmp = Mid(StrTmp, 2, Len(StrTmp) - 1) & " " & Left(StrTmp, 1)
.Text = StrTmp
End With
.Start = Rng.End
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

Paul_Hossler
03-18-2012, 06:16 PM
Can you explain more why you want to do this?



$1 would change to 1 $
and $500,000,000,000 to 500 000 000 000 $


It would seen that $ 1 in USD would not be reformatted to 1 $

Paul

rastapopoulo
03-18-2012, 07:04 PM
Excellent, thanks again!

Noticed one last thing:


In financial statements, negative numbers appear in parentheses:


$ (1,505)

Can you amend the script to transform the above into the following?

(1 505) $

macropod
03-18-2012, 07:22 PM
You should be able to get that result with:
Sub FrenchNumFormat()
Application.ScreenUpdating = False
Dim Rng As Range, StrTmp As String
With ActiveDocument.Range
With .Find
.ClearFormatting
'the find expression is any numeric 'word'
.Text = "<[0-9]@>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
Set Rng = .Duplicate
With Rng
'move our start backwards until all possible valid currency characters are found
While .Characters.First.Previous.Text Like "[(" & vbTab & " $€ŁĄ]"
.Start = .Start - 1
Wend
'move our end forwards until all all possible valid number-format characters are found
If InStr(.Text, "(") > 0 Then
While .Characters.Last.Next.Text Like "[0-9,.)]"
.End = .End + 1
Wend
Else
While .Characters.Last.Next.Text Like "[0-9,.]"
.End = .End + 1
Wend
End If
'move our start forwards until all invalid non-currency characters are excluded
If InStr(.Text, ")") > 0 Then
While .Characters.First.Text Like "[" & vbTab & " ]"
.Start = .Start + 1
Wend
Else
While .Characters.First.Text Like "[" & vbTab & " (]"
.Start = .Start + 1
Wend
End If
'move our end forwards until all punctuation characters are excluded
If InStr(.Text, "(") > 0 Then
While .Characters.Last.Text Like "[,.]"
.End = .End - 1
Wend
Else
While .Characters.Last.Text Like "[,.)]"
.End = .End - 1
Wend
End If
StrTmp = Replace(Replace(Replace(Replace(.Text, " ", ""), vbTab, ""), ",", " "), ".", ",")
If Left(StrTmp, 1) Like "[$€ŁĄ]" Then _
StrTmp = Mid(StrTmp, 2, Len(StrTmp) - 1) & " " & Left(StrTmp, 1)
.Text = StrTmp
End With
.Start = Rng.End
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub
As you can see, little additions to the criteria can add a great deal to the code requirements.

rastapopoulo
04-03-2012, 06:40 AM
Thank you very much, Paul. I just go around to looking at your updated code and it works very well. I believe that's exactly what I needed. Much appreciated!