Separator Ultimate 1000 wykorzystujący VBA
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
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.International
zgodnie z sugestią @RonRosenfeld.
Musisz rozszerzyć format liczb, aby obejmował większe liczby.
### ### ## 0 ","
