Excel und VBA: Formeln, Programmierung, Lösungen

StandardModule: basMain

Public Function ZWortEn(Number As Double)
   Dim m As Double
   m = Abs(Int(Number + 0.5))
   m = Fix(Number)
   Select Case m
      Case Is < 100
         ZWortEn = TextNum10(CInt(m))
      Case Is < 1000
         ZWortEn = TextNum100(CInt(m))
      Case Is < 1000000
         ZWortEn = TextNum1000(CInt(m))
      Case Else
         ZWortEn = TextNum1000000(CInt(m))
   End Select
   If Number < 0 Then ZWortEn = "minus " + ZWortEn
   ZWortEn = UCase(Left(ZWortEn, 1)) + Mid(ZWortEn, 2)
   End Function
   
Private Function TextNum10(n As Integer)
   Select Case n
      Case 0
         TextNum10 = "zero"
      Case Is < 20
         TextNum10 = Einer(n)
      Case Else
         TextNum10 = Zweier(Int(n / 10))
         If n <> Int(n / 10) * 10 Then TextNum10 = TextNum10 + "-" + _
            Einer(n - Int(n / 10) * 10)
      End Select
   End Function
   
Private Function TextNum100(n As Integer)
   Dim h#, x$
   h = Int(n / 100)
   x = TextNum10(n - h * 100)
   If x = "zero" Then
      TextNum100 = Einer(CInt(h)) + " hundred"
   Else
      TextNum100 = Einer(CInt(h)) + " hundred and " + x
   End If
End Function

Private Function TextNum1000(n As Integer)
   Dim k#
   If n < 100000 Then
      TextNum1000 = TextNum10(Int(n / 1000)) + " thousand "
   Else
      TextNum1000 = TextNum100(Int(n / 1000)) + " thousand "
   End If
   k = Int(n / 1000)
   Select Case n - k * 1000
      Case 0
         TextNum1000 = TextNum1000
      Case Is < 100
         TextNum1000 = TextNum1000 + "and " + TextNum10(n - k * 1000)
      Case Else
         TextNum1000 = TextNum1000 + TextNum100(n - k * 1000)
   End Select
   End Function
   
Private Function TextNum1000000(n As Integer)
   Dim k#
   If n < 100000000 Then
      TextNum1000000 = TextNum10(Int(n / 1000000)) + " million "
   Else
      TextNum1000000 = TextNum100(Int(n / 1000000)) + " million "
   End If
   
   k = Int(n / 1000000)
   
   Select Case n - k * 1000000
      Case 0
         TextNum1000000 = TextNum1000000
      Case Is < 100
         TextNum1000000 = TextNum1000000 + "and " + TextNum10(n - k * 1000000)
      Case Is < 1000
         TextNum1000000 = TextNum1000000 + TextNum100(n - k * 1000000)
      Case Else
         TextNum1000000 = TextNum1000000 + TextNum1000(n - k * 1000000)
   End Select
   End Function
   
Private Function Einer(z As Integer) As String
   Einer = WorksheetFunction.Choose(z, "one", "two", "three", "four", "five", _
      "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", _
      "fourteen", "fifteen", "sexteen", "eighteen", "nineteen")
End Function

Private Function Zweier(z As Integer) As String
   Zweier = WorksheetFunction.Choose(z - 1, "twenty", "thirty", _
      "forty", "fifty", "sixty", "seventy", "eighty", "ninety")
End Function

    

Beiträge aus dem Excel-Forum zu den Themen UDF und Zahlwort