Excel - Format value (mask)

后端 未结 1 1798
时光说笑
时光说笑 2020-12-07 06:00

I\'d like to format a cell value this way:

1234,980 -> 1.234,980

12237119867,761 -> 12.237.119.867,761

How to prepare a common mask, that will set do

相关标签:
1条回答
  • 2020-12-07 06:26

    Define the first segment to the left of the decimal dot. It will be automatically duplicated as needed.
    Number of octothorpes after the dot sets the maximum number of decimal places after the dot, only required number of the will be used.

    Something like:

    #.###,0##
    

    (I'm assuming that would be valid for your current locale).

    As suggested by the phoog's comment, locale-independent format would be:

    #,###.0##
    

    (use that to set format using Cell.NumberFormat = "#,###.0##")


    As for some VBA code, you may have an enhanced version of the Format function that accepts two locales, one which is the format string is in, and another one to use for formatting result.

    Place the following in a separate module:

    Option Explicit
    
    #If VBA7 Then
    Private Declare PtrSafe Function VarTokenizeFormatString Lib "oleaut32.dll" (ByVal pstrFormat As LongPtr, ByRef rgbTok As Any, ByVal cbTok As Long, ByVal iFirstDay As VbDayOfWeek, ByVal iFirstWeek As VbFirstWeekOfYear, ByVal lcid As Long, ByRef pcbActual As Long) As Long
    Private Declare PtrSafe Function VarFormatFromTokens Lib "oleaut32.dll" (ByRef pvarIn As Variant, ByVal pstrFormat As LongPtr, ByRef pbTokCur As Any, ByVal dwFlags As Long, ByRef pbstrOut As LongPtr, ByVal lcid As Long) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    #Else
    Private Declare Function VarTokenizeFormatString Lib "oleaut32.dll" (ByVal pstrFormat As Long, ByRef rgbTok As Any, ByVal cbTok As Long, ByVal iFirstDay As VbDayOfWeek, ByVal iFirstWeek As VbFirstWeekOfYear, ByVal lcid As Long, ByRef pcbActual As Long) As Long
    Private Declare Function VarFormatFromTokens Lib "oleaut32.dll" (ByRef pvarIn As Variant, ByVal pstrFormat As Long, ByRef pbTokCur As Any, ByVal dwFlags As Long, ByRef pbstrOut As Long, ByVal lcid As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    #End If
    
    Private Const S_OK As Long = 0
    Private Const E_INVALIDARG As Long = &H80070057
    Private Const E_OUTOFMEMORY As Long = &H8007000E
    Private Const DISP_E_BUFFERTOOSMALL As Long = &H80020013
    Private Const DISP_E_TYPEMISMATCH As Long = &H80020005
    
    
    Public Function FormatForLocale(ByVal Expression As Variant, Optional ByVal Format As String, Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, Optional ByVal FirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem, Optional ByVal PatternLocaleID As Long = 0, Optional ByVal TargetLocaleID As Long = 0) As String
      Dim b() As Byte, t As Long
      Dim hResult As Long
      #If VBA7 Then
      Dim pBstrResult As LongPtr
      #Else
      Dim pBstrResult As Long
      #End If
      Dim res As String
    
      Const CHUNK_SIZE As Long = 256
    
    
      If TypeOf Expression Is Excel.Range Then
        Expression = Expression.Value
      End If
    
    
      ReDim b(1 To CHUNK_SIZE)
    
      Do
        hResult = VarTokenizeFormatString(StrPtr(Format), b(LBound(b)), UBound(b) - LBound(b) + 1, FirstDayOfWeek, FirstWeekOfYear, PatternLocaleID, t)
    
        Select Case hResult
        Case S_OK
          Exit Do
        Case E_INVALIDARG
          Err.Raise 5, , "Some arguments are invalid."
        Case DISP_E_BUFFERTOOSMALL
          ReDim b(LBound(b) To UBound(b) + CHUNK_SIZE)
        Case Else
          Err.Raise 5, , "Internal error. Unexpected error code returned from system."
        End Select
      Loop
    
      Select Case VarFormatFromTokens(Expression, StrPtr(Format), b(LBound(b)), 0, pBstrResult, TargetLocaleID)
      Case S_OK
        CopyMemory ByVal VarPtr(res), pBstrResult, Len(pBstrResult)
      Case E_OUTOFMEMORY
        Err.Raise 7
      Case E_INVALIDARG
        Err.Raise 5, , "Some arguments are invalid."
      Case DISP_E_TYPEMISMATCH
        Err.Raise 5, , "The argument could not be coerced to the specified type."
      Case Else
        Err.Raise 5, , "Internal error. Unexpected error code returned from system."
      End Select
    
      FormatForLocale = res
    End Function
    

    Now you have a function, FormatForLocale, that mimics the default VBA Format function, but adds two additional parameters. To get the result you want, you can do:

    result = FormatForLocale(123456789, "#,###.0##", , , LOCALE_INVARIANT, LOCALE_GERMAN)
    

    where LOCALE_INVARIANT and LOCALE_GERMAN are constants you can look up here.

    You can call it from a worksheet as well:

    =FormatForLocale(123456789,"#,###.0##",,,127,3079)
    
    0 讨论(0)
提交回复
热议问题