如何使用VBA

Question

數值轉換爲詞孟加拉國貨幣在Excel

enter image description here

請參閱圖像：

https://support.microsoft.com/en-us/help/213360/how-to-convert-a-numeric-value-into-english-words-in-excel

Answer 1

這可能比你討價還價的更多，但可能會更好比如果它更少。嘗試一下。但首先，請理解設置。這個想法是，你有一個單元格 - 當然在工作表中 - 你輸入一個金額。然後你有另一個單元格 - 推測是在同一張工作表上，但不一定如此 - 在其中顯示字數。將隨後的調用過程粘貼到工作表的代碼表中，在該工作表中您有單元格以包含金額。

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 

    Const AmountCell As String = "B5"   ' read the amount from here 
    Const TargetCell As String = "D5"   ' write the words here 
    Const Indian As Boolean = True 

    If Target.Address = Range(AmountCell).Address Then 
     Call WriteAmountInWords(Target.Value, Range(TargetCell), Indian) 
    End If 
End Sub 

此代碼有很多參數可以設置。他們從上述程序開始。金額將寫入單元格B5。您可以指定任何其他單元格。您可以添加代碼來指定多個單元格。如果您需要在另一張工作表上執行相同的操作，則還需要將該代碼的副本粘貼到其他工作表的代碼表中。

上述代碼指定要寫入單元格D5的單詞。您可以隱式或相對於AmountCell指定任何其他單元格。這是另一項沒有涉及的編程任務。

最後，您可以指定Indian爲True或False。如果你將它指定爲True，你會得到十萬盧比和千分之一。假將產生數百萬和數十億。如果這是你的需要，你也可以通過編程來設置這個屬性。但請注意，目前的結構不適合動態變化。你將不得不用常量替換變量。

上面的代碼調用程序WriteAmountInWords，它有很多它需要的支持代碼。所有這些都必須在一個新的，普通的（不是類而不是形式）代碼模塊上。它的名字並不重要，但你可以稱它爲SpellNum。將所有以下代碼粘貼到該模塊中。

Option Explicit 
Option Base 0 

Enum Ncr      ' Index to Array Curr() 
    NcrCurr 
    NcrOnly      ' word used when there are no cents 
    NcrAnd      ' word used between dollars and cents 
    NcrFraction 
End Enum 

Enum Nct      ' CaseType 
    NctLower     ' = all lower case 
    NctFirst     ' = Only first character in upper case 
    NctProper     ' = Each word's first character capitalised (Default) 
    NctUpper     ' = all caps 
End Enum 

Enum Ngp      ' Number groups: Powers of 1000 
    NgpN 
    NgpM      ' = 1000's 
    NgpMM      ' = millions 
    NgpBn      ' = billions 
    NgpDec      ' decimals 
End Enum 

    Const SpellCurr As String = "dollar,only,and,cent" 
    Const Ones As String = "zero one two three four five six seven eight nine" 
    Const Teens As String = "teen eleven twelve thir four fif six seven eigh nine" 
    Const Tens As String = "null ten twenty thirty fourty fifty sixty seventy eighty ninety" 
    Const Powers_En As String = "hundred thousand million billion" 
    Const Powers_In As String = "hundred thousand lakh crore" 
    Dim Powers As String 

Public Sub WriteAmountInWords(ByVal Amt As Variant, _ 
           ByRef TargetCell As Range, _ 
           ByVal Indian As Boolean) 

    Const WithCurr As Boolean = False 
    Const NoDecs As Boolean = False 
    Const SpellDecs As Boolean = False 
    Const CaseType As Long = NctProper 

    TargetCell.Value = SpellAmount(Amt, Indian, WithCurr, NoDecs, SpellDecs, CaseType) 
End Sub 

Private Function SpellAmount(ByVal Amt As Variant, _ 
          ByVal Indian As Boolean, _ 
          ByVal WithCurr As Boolean, _ 
          ByVal NoDecs As Boolean, _ 
          ByVal SpellDecs As Boolean, _ 
          ByVal CaseType As Long) As String 

    ' return the amount Amt in words 
    ' include the currency, if WithCurr = True 
    ' True to suppress zero fractions in integers, 
     ' also ignore fractions existing in Amt 
    ' write out fractions, if SpellDecs = True 
    ' specify any Nct value for CaseType (Proper by default) 

    Dim Num As Double     ' = Amt 
    Dim Spa As String     ' result 
    Dim S As String      ' partial result 
    Dim Sp() As String     ' groups of numbers 
    Dim G As Ngp 

    Powers = IIf(Indian, Powers_In, Powers_En) 
    Num = SetGroups(Amt, Sp, Indian) 
    For G = NgpBn To NgpN Step -1 
     If Val(Sp(G)) > 0 Then 
      S = Spell999(Sp(G)) 
      If G > NgpN Then 
       S = WithBreak(S, True) & Split(Powers)(G) 
      End If 
      Spa = WithBreak(Spa, True) & S 
     End If 
    Next G 
    If Len(Spa) = 0 Then Spa = Split(Ones)(0) 

    If NoDecs Then 
     If WithCurr Then Call AddCurrency(Spa, Int(Num)) 
    Else 
     Call AddDecimals(Spa, Sp(NgpDec), SpellDecs, WithCurr, Num) 
    End If 

    SpellAmount = WriteProper(Spa, CaseType) 
End Function 

Private Function Spell999(G3 As String) As String 
    ' return the amount in words of a G3 of 3 numbers 

    Dim Sp As String     ' result 
    Dim S As String      ' partial result 
    Dim n(1 To 3) As Integer   ' value of each character 
    Dim IsTeen As Boolean 
    Dim i As Long 

    For i = 1 To 3 
     n(i) = Val(Mid(Right("000" & G3, 3), i, 1)) 
    Next i 
    If n(1) > 0 Then Sp = WithBreak((Split(Ones)(n(1)))) & _ 
          Split(Powers)(NgpN) 

    If n(2) = 1 And n(3) > 0 Then 
     IsTeen = True 
    ElseIf n(2) Then 
     Sp = WithBreak(Sp) & Split(Tens)(n(2)) 
    End If 

    If n(3) Then 
     If IsTeen Then 
      S = Split(Teens)(n(3)) 
      If n(3) > 2 Then 
       S = WithBreak(S) & Split(Teens)(0) 
      End If 
     Else 
      S = Split(Ones)(n(3)) 
     End If 
     Sp = WithBreak(Sp) & S 
    End If 
    Spell999 = Sp 
End Function 

Private Sub AddDecimals(ByRef Spa As String, _ 
         ByVal Decs As String, _ 
         ByVal SpellDecs As Boolean, _ 
         ByVal WithCurr As Boolean, _ 
         ByVal Num As Double) 
    Dim S As String 

    If WithCurr And SpellDecs Then Call AddCurrency(S, Int(Num)) 
    S = WithBreak(S, True) & Split(SpellCurr, ",") _ 
            (NcrOnly - CBool(Val(Decs))) 
    If SpellDecs Then 
     If Val(Decs) Then 
      S = WithBreak(S, True) & Spell999(Decs) 
      If WithCurr Then 
       Call AddCurrency(S, Val(Decs), True) 
      Else 
       S = WithBreak(S, True) & Split(Powers)(0) & "th" 
      End If 
     End If 
    Else 
     S = WithBreak(S, True) & Decs & "/100" 
     If WithCurr Then Call AddCurrency(S, Num) 
    End If 
    Spa = WithBreak(Spa, True) & S 
End Sub 

Private Function SetGroups(ByVal Amt As Variant, _ 
          ByRef Sp() As String, _ 
          ByVal Indian As Boolean) As Double 
    ' Sp() is a return array 

    Dim Grps() As Variant 
    Dim A As String 
    Dim n As Integer 
    Dim i As Integer 

    If Indian Then 
     Grps = Array(5, 2, 2, 3)   ' from left to right 
    Else 
     Grps = Array(3, 3, 3, 3) 
    End If 
    ReDim Sp(NgpDec) 

    A = Format(Unformat(Amt), String(12, "0") & ".00") 
    For i = NgpN To (NgpDec - 1) 
     Sp(NgpDec - i - 1) = Mid(A, n + 1, Grps(i)) 
     n = n + Grps(i) 
    Next i 
    Sp(NgpDec) = Right(A, 2) 
    SetGroups = Val(A) 
End Function 

Private Function Unformat(ByVal Amt As Variant) As String 

    Dim Uf As String 
    Dim S As String 
    Dim i As Integer 

    For i = 1 To Len(Amt) 
     S = Mid(Amt, i, 1) 
     If IsNumeric(S) Or S = "." Then 
      Uf = Uf & S 
     End If 
    Next i 
    Unformat = Uf 
End Function 

Private Function WithBreak(ByVal S As String, _ 
          Optional ByVal AddSpace As Boolean) _ 
          As String 
    ' append a conditional line break or space to S 

    Dim BreakChar As Integer 

    BreakChar = IIf(AddSpace, 32, 31) 
    WithBreak = S 
    If Len(S) > 1 Then 
     If Asc(Right(S, 1)) <> BreakChar Then 
      WithBreak = S + Chr(BreakChar) 
     End If 
    End If 
End Function 

Private Function WriteProper(ByVal S As String, _ 
          ByVal CaseType As Nct) As String 

    Dim Wp As String 
    Dim Sp() As String 
    Dim n As Long 

    If Len(S) Then 
     Wp = LCase(S) 
     Select Case CaseType 
      Case NctFirst 
       Wp = UCase(Left(S, 1)) & Mid(S, 2) 
      Case NctProper 
       Sp = Split(Wp) 
       For n = LBound(Sp) To UBound(Sp) 
        Sp(n) = UCase(Left(Sp(n), 1)) & Mid(Sp(n), 2) 
       Next n 
       Wp = Join(Sp) 
      Case NctUpper 
       Wp = UCase(S) 
     End Select 
    End If 
    WriteProper = Wp 
End Function 

Private Sub AddCurrency(ByRef Spa As String, _ 
         ByVal Num As Double, _ 
         Optional IsFraction As Boolean) 
    Dim S As String 
    Dim i As Ncr 

    i = IIf(IsFraction, NcrFraction, NcrCurr) 
    S = Split(SpellCurr, ",")(i) & IIf(Num = 1, "", "s") 
    Spa = WithBreak(Spa, True) & S 
End Sub 

尋找這行代碼Const SpellCurr As String = "dollar,only,and,cent"。將美元更改爲您的貨幣名稱。 「仙」也一樣。但是，默認情況下，這些文字將被編寫而不用命名貨幣。您必須通過將Const WithCurr As Boolean = False更改爲True來啓用該功能。

此設置不包括書面金額的小數。 Const NoDecs As Boolean = False。您可以將其更改爲True。一旦它是True，您可以指定如何寫入小數，單詞或數字。 Const SpellDecs As Boolean = False默認值爲False，意思是寫成數字，如00/100。

WriteAmountInWords過程中的最後一個常量決定了拼寫數量的大小寫。 Const CaseType As Long = NctProper。要設置此常量，請使用代碼頂部的枚舉之一（此處重複）。

Enum Nct      ' CaseType 
    NctLower     ' = all lower case 
    NctFirst     ' = Only first character in upper case 
    NctProper     ' = Each word's first character capitalised (Default) 
    NctUpper     ' = all caps 
End Enum 

請注意，enuration名稱的大小會根據您的偏好進行調整。一旦你不同的名字大寫，VBA會記住並遵循你的指導。輸入負責任的。