Chuyển số thành từ (Microsoft Excel)
Đôi khi việc đánh vần các con số là điều có lợi, hoặc thậm chí là bắt buộc. Ví dụ: bạn có thể muốn đánh vần “1234” thành “một nghìn hai trăm ba mươi bốn.” Macro sau đây, NumberToWords, thực hiện điều đó. Nó khá dài, nhưng phải kiểm tra rất nhiều để ghép chuỗi thích hợp. Thực tế có năm macro trong tập hợp; bốn bên cạnh NumberToWords được NumberToWords gọi để thực hiện chuyển đổi thực tế.
NumberToWords sẽ chuyển đổi bất kỳ số nào từ 0 đến 999,999. Để sử dụng nó, chỉ cần chọn ô (hoặc các ô) có nội dung bạn muốn chuyển đổi, sau đó chạy nó. Bạn cần lưu ý rằng các ô phải chứa giá trị số nguyên, không phải công thức dẫn đến giá trị số nguyên. Nội dung thực tế của các ô tuân thủ được thay đổi từ số ban đầu thành biểu diễn văn bản của số đó. Nói cách khác, đây không phải là thay đổi định dạng mà là thay đổi giá trị cho các ô đó.
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 là nguồn của bạn để đào tạo Microsoft Excel hiệu quả về chi phí.
Mẹo này (8351) áp dụng cho Microsoft Excel 2007, 2010 và 2013. Bạn có thể tìm phiên bản của mẹo này cho giao diện menu cũ hơn của Excel tại đây: