如何使用VBA
回答
這可能比你討價還價的更多,但可能會更好比如果它更少。嘗試一下。但首先,請理解設置。這個想法是,你有一個單元格 - 當然在工作表中 - 你輸入一個金額。然後你有另一個單元格 - 推測是在同一張工作表上,但不一定如此 - 在其中顯示字數。將隨後的調用過程粘貼到工作表的代碼表中,在該工作表中您有單元格以包含金額。
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會記住並遵循你的指導。輸入負責任的。
- 1. 如何使用VBA
- 2. 如何使用VBA
- 3. 如何使用VBA
- 4. 如何使用VBA
- 5. 如何使用VBA
- 6. 如何使用VBA
- 7. 如何使用VBA
- 8. 如何使用VBA
- 9. 如何使用VBA
- 10. 如何使用VBA
- 11. 如何使用VBA
- 12. 如何使用VBA
- 13. 如何使用VBA
- 14. 如何使用VBA
- 15. 如何找到使用VBA
- 16. 如何使用VBA或VBScript
- 17. 如何使用Excel VBA
- 18. 如何識別使用VBA
- 19. MS Excel如何使用VBA
- 20. 如何使用訪問VBA
- 21. 如何使用VBA代碼
- 22. 如何颳去使用VBA
- 23. 如何使用VBA的Excel
- 24. 如何使用Excel VBA 2007
- 25. 如何從Datastore.prime使用VBA
- 26. 如何圖表使用VBA
- 27. 如何使用VBA由表
- 28. 如何使用Excel VBA
- 29. 如何安裝使用VBA
- 30. 如何獲得使用VBA
沒有冒犯意味,但請將問題轉換爲英文。 –
@ A.S.H - 據我所知,沒有任何問題 - 只是一些示例代碼。這似乎來自https://support.microsoft。com/en-au/help/213360/how-to-convert-a-numeric-value-into-english-words-in-excel(用幾個詞改變) – YowE3K
請看圖像。我想將數字轉換爲下面的文字。 https://i.stack.imgur.com/1fDUj.jpg –