Konvertieren von Zahlen in Wörter (Microsoft Excel)
Es gibt Zeiten, in denen es vorteilhaft oder sogar obligatorisch ist, Zahlen zu buchstabieren. Zum Beispiel möchten Sie vielleicht „1234“ als „eintausendzweihundertvierunddreißig“ buchstabieren. Das folgende Makro, NumberToWords, macht genau das. Es ist ziemlich lang, aber es muss viel überprüft werden, um die richtige Zeichenfolge zusammenzustellen. Es gibt tatsächlich fünf Makros im Set; Die vier neben NumberToWords werden von NumberToWords aufgerufen, um die eigentliche Konvertierung durchzuführen.
NumberToWords konvertiert eine beliebige Zahl zwischen 0 und 999.999. Um es zu verwenden, wählen Sie einfach die Zelle (n) aus, deren Inhalt Sie konvertieren möchten, und führen Sie es dann aus. Sie sollten beachten, dass die Zellen ganzzahlige Werte enthalten müssen, keine Formeln, die zu ganzzahligen Werten führen. Der tatsächliche Inhalt der kompatiblen Zellen wird von der ursprünglichen Nummer in eine Textdarstellung dieser Nummer geändert. Mit anderen Worten, dies ist keine Formatänderung, sondern eine Wertänderung für diese Zellen.
Sub NumberToWords() Dim rngSrc As Range Dim lMax As Long Dim lCtr As Long Dim bNCFlag As Boolean Dim sTitle As String, sMsg As String Dim vCVal As Variant Dim lNumber As Long, sWords As String Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address) lMax = rngSrc.Cells.Count bNCFlag = False For lCtr = 1 To lMax vCVal = rngSrc.Cells(lCtr).Value sWords = "" If IsNumeric(vCVal) Then If vCVal <> CLng(vCVal) Then bNCFlag = True Else lNumber = CLng(vCVal) Select Case lNumber Case 0 sWords = "Zero" Case 1 To 999999 sWords = SetThousands(lNumber) Case Else bNCFlag = True End Select End If Else bNCFlag = True End If If sWords > "" Then rngSrc.Cells(lCtr) = sWords End If Next lCtr If bNCFlag Then sTitle = "lNumberToWords Macro" sMsg = "Not all cells converted. May not be whole number or may be too large." MsgBox sMsg, vbExclamation, sTitle End If End Sub
Private Function SetOnes(ByVal lNumber As Integer) As String Dim OnesArray(9) As String OnesArray(1) = "One" OnesArray(2) = "Two" OnesArray(3) = "Three" OnesArray(4) = "Four" OnesArray(5) = "Five" OnesArray(6) = "Six" OnesArray(7) = "Seven" OnesArray(8) = "Eight" OnesArray(9) = "Nine" SetOnes = OnesArray(lNumber) End Function
Private Function SetTens(ByVal lNumber As Integer) As String Dim TensArray(9) As String TensArray(1) = "Ten" TensArray(2) = "Twenty" TensArray(3) = "Thirty" TensArray(4) = "Fourty" TensArray(5) = "Fifty" TensArray(6) = "Sixty" TensArray(7) = "Seventy" TensArray(8) = "Eighty" TensArray(9) = "Ninety" Dim TeensArray(9) As String TeensArray(1) = "Eleven" TeensArray(2) = "Twelve" TeensArray(3) = "Thirteen" TeensArray(4) = "Fourteen" TeensArray(5) = "Fifteen" TeensArray(6) = "Sixteen" TeensArray(7) = "Seventeen" TeensArray(8) = "Eighteen" TeensArray(9) = "Nineteen" Dim iTemp1 As Integer Dim iTemp2 As Integer Dim sTemp As String iTemp1 = Int(lNumber / 10) iTemp2 = lNumber Mod 10 sTemp = TensArray(iTemp1) If (iTemp1 = 1 And iTemp2 > 0) Then sTemp = TeensArray(iTemp2) Else If (iTemp1 > 1 And iTemp2 > 0) Then sTemp = sTemp + " " + SetOnes(iTemp2) End If End If SetTens = sTemp End Function
Private Function SetHundreds(ByVal lNumber As Integer) As String Dim iTemp1 As Integer Dim iTemp2 As Integer Dim sTemp As String iTemp1 = Int(lNumber / 100) iTemp2 = lNumber Mod 100 If iTemp1 > 0 Then sTemp = SetOnes(iTemp1) + " Hundred" If iTemp2 > 0 Then If sTemp > "" Then sTemp = sTemp + " " If iTemp2 < 10 Then sTemp = sTemp + SetOnes(iTemp2) If iTemp2 > 9 Then sTemp = sTemp + SetTens(iTemp2) End If SetHundreds = sTemp End Function
Private Function SetThousands(ByVal lNumber As Long) As String Dim iTemp1 As Integer Dim iTemp2 As Integer Dim sTemp As String iTemp1 = Int(lNumber / 1000) iTemp2 = lNumber Mod 1000 If iTemp1 > 0 Then sTemp = SetHundreds(iTemp1) + " Thousand" If iTemp2 > 0 Then If sTemp > "" Then sTemp = sTemp + " " sTemp = sTemp + SetHundreds(iTemp2) End If SetThousands = sTemp End Function
ExcelTips ist Ihre Quelle für kostengünstige Microsoft Excel-Schulungen.
Dieser Tipp (8351) gilt für Microsoft Excel 2007, 2010 und 2013. Eine Version dieses Tipps für die ältere Menüoberfläche von Excel finden Sie hier: