[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim uPlg As Object, oCel As Range, tf As Boolean
Do
On Error Resume Next
With Range("B2").Offset(0, -tf)
Set uPlg = Intersect(Target, .Resize(Cells(Rows.Count, .Column).End(xlUp).Row - .Row, 1).Offset(1, 0))
If Not uPlg Is Nothing Then
For Each oCel In uPlg.Cells
oCel.Offset(0, 1 + tf).NumberFormat = aaa(CStr(oCel.Offset(0, tf).Value))
Next oCel
End If
End With
On Error GoTo 0
tf = Not tf
Loop While tf
End Sub
Private Function aaa(s As String) As String
Dim UM
UM = Array("EURO", "RmB", "USD", "JPY", "GBP", "CAD", "HKD")
Select Case s
Case UM(0): s = "EUR"
Case UM(1): s = "RmB"
Case UM(2): s = "USD"
Case UM(3): s = "JPY"
Case UM(4): s = "GBP"
Case UM(5): s = "CAD"
Case UM(6): s = "HKD"
Case Else: s = ""
End Select
If s = "" Then
aaa = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
Else
aaa = "_-* #,##0.00 [$" & s & "]_-;-* #,##0.00 [$" & s & "]_-;_-* ""-""?? [$" & s & "]_-;_-@_-"
End If
End Function[/B][/COLOR]