Separator Ultimate 1000 wykorzystujący VBA

Aug 16 2020

Próbowałem uzyskać rozwiązanie VBA dla separatora 1000, ponieważ w moim przypadku nie jest możliwe użycie formuły i należy to zrobić z niestandardowym kodem. Bieżące rozwiązanie jest pobierane z formatu liczbowego odpowiedzi z separatorem tysięcy i dziesiętnym, jeśli to konieczne

Oto kod:

Function CustomFormat(InputValue As Double) As String
    CustomFormat = Format(InputValue, "# ###")
    If (Right(CustomFormat, 1) = ".") Then
        CustomFormat = Left(CustomFormat, Len(CustomFormat) - 1)
    End If
End Function

Działa dla liczb takich jak 1000, ale nie działa dla 1000000. Również 1000000000 nie będzie działać. Obecnie pracuję nad rozwiązaniem, ale jeśli ktoś ma coś do udostępnienia, będzie to mile widziane.

W przypadku zastosowania oryginalnego rozwiązania:

Function CustomFormat(InputValue As Double) As String
    CustomFormat = Format(InputValue, "#,###.##")
    If (Right(CustomFormat, 1) = ".") Then
        CustomFormat = Left(CustomFormat, Len(CustomFormat) - 1)
    End If
End Function

Odpowiedzi

5 SuperSymmetry Aug 16 2020 at 19:40

Myślę, że VBA potrzebuje separatora tysięcy zdefiniowanego w ustawieniach regionalnych. Ponieważ w twoim przypadku jest to przecinek, możesz zrobić coś takiego

Function CustomFormat(InputValue As Double) As String
    CustomFormat = Format(InputValue, "#,###")
    If (Right(CustomFormat, 1) = ".") Then
        CustomFormat = Left(CustomFormat, Len(CustomFormat) - 1)
    End If
    CustomFormat = Replace(CustomFormat, ",", " ")
End Function

Innym podejściem jest odczytanie separatora z rejestru. Powinno to działać w różnych ustawieniach regionalnych.

Function CustomFormat(InputValue As Double) As String
    Dim sThousandsSep As String
    Dim sDecimalSep As String
    Dim sFormat As String
    
    sThousandsSep = Application.International(xlThousandsSeparator)
    sDecimalSep = Application.International(xlDecimalSeparator)
    
    ' Up to 6 decimal places
    sFormat = "#" & sThousandsSep & "###" & sDecimalSep & "######"
    
    CustomFormat = Format(InputValue, sFormat)
    If (Right$(CustomFormat, 1) = sDecimalSep) Then CustomFormat = Left$(CustomFormat, Len(CustomFormat) - 1)
    End If
    
    ' Replace the thousands separator with a space
    ' or any other character
    CustomFormat = Replace(CustomFormat, sThousandsSep, " ")
End Function

Edytuj Zmienioną funkcję do użycia Application.Internationalzgodnie z sugestią @RonRosenfeld.

1 TinMan Aug 16 2020 at 23:38

Musisz rozszerzyć format liczb, aby obejmował większe liczby.

### ### ## 0 ","