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!
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.