如何修改SpellNumber函数，实现百位后添加"and"及数字间加连字符

针对需求，我们对现有代码做两处关键修改，以实现百位后添加"and"（如34538转为"Thirty-Four Thousand Five Hundred and Thirty-Eight"）并保留数字间的连字符功能：

修改点说明 #

1. 修复HundredsTensUnits函数的"and"逻辑：原代码在bUseAnd为true时无条件添加"and"，即使百位后无剩余数字（如100会变成"One Hundred and "）。调整为仅在百位后存在十位/个位数字时才添加"and"。
2. 传递bUseAnd参数到所有HundredsTensUnits调用：原代码仅对最后一段数字传递该参数，导致千位、百万位等分段中的百位后不会添加"and"（如123456会变成"One Hundred Twenty-Three Thousand Four Hundred Fifty-Six"而非正确的带"and"版本）。

优化后的完整代码 #

Private sNumberText() As String

Public Function SpellNumber(NumberIn As Variant, Optional _
                AND_or_CHECK_or_DOLLAR_or_CHECKDOLLAR As String) As String
   Dim cnt As Long
   Dim DecimalPoint As Long
   Dim CardinalNumber As Long
   Dim CommaAdjuster As Long
   Dim TestValue As Long
   Dim CurrValue As Currency
   Dim CentsString As String
   Dim NumberSign As String
   Dim WholePart As String
   Dim BigWholePart As String
   Dim DecimalPart As String
   Dim tmp As String
   Dim sStyle As String
   Dim bUseAnd As Boolean
   Dim bUseCheck As Boolean
   Dim bUseDollars As Boolean
   Dim bUseCheckDollar As Boolean
  '----------------------------------------
  '  初始化格式条件
  '----------------------------------------
   sStyle = LCase(AND_or_CHECK_or_DOLLAR_or_CHECKDOLLAR)
   bUseAnd = sStyle = "and"
   bUseDollars = sStyle = "dollar"
   bUseCheck = (sStyle = "check") Or (sStyle = "dollar")
   bUseCheckDollar = sStyle = "checkdollar"
  '----------------------------------------
  '  检查/创建数字文本数组
  '----------------------------------------
   If Not IsBounded(sNumberText) Then
      Call BuildArray(sNumberText)
   End If
  '----------------------------------------
  '  验证数字并拆分整数/小数部分
  '----------------------------------------
   NumberIn = Trim$(NumberIn)
   If Not IsNumeric(NumberIn) Then
      SpellNumber = "Error - Number improperly formed"
      Exit Function
   Else
      DecimalPoint = InStr(NumberIn, ".")
      If DecimalPoint > 0 Then
         DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
         WholePart = Left$(NumberIn, DecimalPoint - 1)
      Else
         DecimalPoint = Len(NumberIn) + 1
         WholePart = NumberIn
      End If
      If InStr(NumberIn, ",,") Or _
         InStr(NumberIn, ",.") Or _
         InStr(NumberIn, ",.") Or _
         InStr(DecimalPart, ",") Then
         SpellNumber = "Error - Improper use of commas"
         Exit Function
      ElseIf InStr(NumberIn, ",") Then
         CommaAdjuster = 0
         WholePart = ""
         For cnt = DecimalPoint - 1 To 1 Step -1
            If Not Mid$(NumberIn, cnt, 1) Like "[,]" Then
               WholePart = Mid$(NumberIn, cnt, 1) & WholePart
            Else
               CommaAdjuster = CommaAdjuster + 1
               If (DecimalPoint - cnt - CommaAdjuster) Mod 3 Then
                  SpellNumber = "Error - Improper use of commas"
                  Exit Function
               End If
            End If
         Next
      End If
   End If
   If Left$(WholePart, 1) Like "[+-]" Then
      NumberSign = IIf(Left$(WholePart, 1) = "-", "Minus ", "Plus ")
      WholePart = Mid$(WholePart, 2)
   End If
  '----------------------------------------
  '  处理支票模式下的小数部分四舍五入
  '----------------------------------------
   If bUseCheck = True Then
      CurrValue = CCur(Val("." & DecimalPart))
      DecimalPart = Mid$(Format$(CurrValue, "0.00"), 3, 2)
      If CurrValue >= 0.995 Then
         If WholePart = String$(Len(WholePart), "9") Then
            WholePart = "1" & String$(Len(WholePart), "0")
         Else
            For cnt = Len(WholePart) To 1 Step -1
              If Mid$(WholePart, cnt, 1) = "9" Then
                 Mid$(WholePart, cnt, 1) = "0"
              Else
                 Mid$(WholePart, cnt, 1) = _
                            CStr(Val(Mid$(WholePart, cnt, 1)) + 1)
                 Exit For
              End If
            Next
         End If
      End If
   End If
  '----------------------------------------
  '  拆分超大数字为可处理的分段
  '----------------------------------------
   If Len(WholePart) > 9 Then
      BigWholePart = Left$(WholePart, Len(WholePart) - 9)
      WholePart = Right$(WholePart, 9)
   End If
   If Len(BigWholePart) > 9 Then
      SpellNumber = "Error - Number too large"
      Exit Function
   ElseIf Not WholePart Like String$(Len(WholePart), "#") Or _
         (Not BigWholePart Like String$(Len(BigWholePart), "#") _
          And Len(BigWholePart) > 0) Then
      SpellNumber = "Error - Number improperly formed"
      Exit Function
   End If
  '----------------------------------------
  '  生成数字文本
  '----------------------------------------
  '  处理超大数值（十亿以上）
   TestValue = Val(BigWholePart)
   If TestValue > 999999 Then
      CardinalNumber = TestValue \ 1000000
      tmp = HundredsTensUnits(CardinalNumber, bUseAnd) & "Quadrillion "
      TestValue = TestValue - (CardinalNumber * 1000000)
   End If
   If TestValue > 999 Then
     CardinalNumber = TestValue \ 1000
     tmp = tmp & HundredsTensUnits(CardinalNumber, bUseAnd) & "Trillion "
     TestValue = TestValue - (CardinalNumber * 1000)
   End If
   If TestValue > 0 Then
      tmp = tmp & HundredsTensUnits(TestValue, bUseAnd) & "Billion "
   End If
  '  处理较小数值（十亿以下）
   TestValue = Val(WholePart)
   If TestValue = 0 And BigWholePart = "" Then tmp = "Zero "
   If TestValue > 999999 Then
      CardinalNumber = TestValue \ 1000000
      tmp = tmp & HundredsTensUnits(CardinalNumber, bUseAnd) & "Million "
      TestValue = TestValue - (CardinalNumber * 1000000)
   End If
   If TestValue > 999 Then
      CardinalNumber = TestValue \ 1000
      tmp = tmp & HundredsTensUnits(CardinalNumber, bUseAnd) & "Thousand "
      TestValue = TestValue - (CardinalNumber * 1000)
   End If
   If TestValue > 0 Then
      If Val(WholePart) < 99 And BigWholePart = "" Then bUseAnd = False
      tmp = tmp & HundredsTensUnits(TestValue, bUseAnd)
   End If
  '  处理不同格式模式（美元、支票等）
   If bUseDollars = True Then
      CentsString = HundredsTensUnits(DecimalPart)
      If tmp = "One " Then
         tmp = tmp & "Dollar"
      Else
         tmp = tmp & "Dollars"
      End If
      If Len(CentsString) > 0 Then
         tmp = tmp & " and " & CentsString
         If CentsString = "One " Then
            tmp = tmp & "Cent"
         Else
            tmp = tmp & "Cents"
         End If
      End If
   ElseIf bUseCheck = True Then
      tmp = tmp & "and " & Left$(DecimalPart & "00", 2)
      tmp = tmp & "/100"
   ElseIf bUseCheckDollar = True Then
      If tmp = "One " Then
         tmp = tmp & "Dollar"
      Else
         tmp = tmp & "Dollars"
      End If
      tmp = tmp & " and " & Left$(DecimalPart & "00", 2)
      tmp = tmp & "/100"
   Else
      If Len(DecimalPart) > 0 Then
        tmp = tmp & "Point"
        For cnt = 1 To Len(DecimalPart)
          tmp = tmp & " " & sNumberText(Mid$(DecimalPart, cnt, 1))
        Next
      End If
   End If
  '  最终调整输出格式
   SpellNumber = Replace(NumberSign & tmp, "y-Thou", "y Thou")
   If Right(SpellNumber, 1) = "-" Then SpellNumber = Left(SpellNumber, Len(SpellNumber) - 1)
End Function

Private Sub BuildArray(sNumberText() As String)
   ReDim sNumberText(0 To 27) As String
   sNumberText(0) = "Zero"
   sNumberText(1) = "One"
   sNumberText(2) = "Two"
   sNumberText(3) = "Three"
   sNumberText(4) = "Four"
   sNumberText(5) = "Five"
   sNumberText(6) = "Six"
   sNumberText(7) = "Seven"
   sNumberText(8) = "Eight"
   sNumberText(9) = "Nine"
   sNumberText(10) = "Ten"
   sNumberText(11) = "Eleven"
   sNumberText(12) = "Twelve"
   sNumberText(13) = "Thirteen"
   sNumberText(14) = "Fourteen"
   sNumberText(15) = "Fifteen"
   sNumberText(16) = "Sixteen"
   sNumberText(17) = "Seventeen"
   sNumberText(18) = "Eighteen"
   sNumberText(19) = "Nineteen"
   sNumberText(20) = "Twenty"
   sNumberText(21) = "Thirty"
   sNumberText(22) = "Forty"
   sNumberText(23) = "Fifty"
   sNumberText(24) = "Sixty"
   sNumberText(25) = "Seventy"
   sNumberText(26) = "Eighty"
   sNumberText(27) = "Ninety"
End Sub

Private Function IsBounded(vntArray As Variant) As Boolean
   On Error Resume Next
   IsBounded = IsNumeric(UBound(vntArray))
End Function

Private Function HundredsTensUnits(ByVal TestValue As Integer, _
                              Optional bUseAnd As Boolean) As String
   Dim CardinalNumber As Integer
   If TestValue > 99 Then
      CardinalNumber = TestValue \ 100
      HundredsTensUnits = sNumberText(CardinalNumber) & " Hundred "
      TestValue = TestValue - (CardinalNumber * 100)
      ' 仅在百位后有剩余数字时添加"and"
      If bUseAnd And TestValue > 0 Then
         HundredsTensUnits = HundredsTensUnits & "and "
      End If
   End If
   If TestValue > 20 Then
      CardinalNumber = TestValue \ 10
      HundredsTensUnits = HundredsTensUnits & _
                          sNumberText(CardinalNumber + 18) & "-"
      TestValue = TestValue - (CardinalNumber * 10)
   End If
   If TestValue > 0 Then
      HundredsTensUnits = HundredsTensUnits & _
                          sNumberText(TestValue) & " "
   End If
End Function

验证示例 #

• 输入34538.00，调用SpellNumber(34538, "and")返回：Thirty-Four Thousand Five Hundred and Thirty-Eight
• 输入1234，返回：One Thousand Two Hundred and Thirty-Four
• 输入45，返回：Forty-Five
• 输入100，返回：One Hundred（无多余"and"）

内容的提问来源于stack exchange，提问作者Samy Somy