Перевтілення StrSum: VBA Excel

StrSum версія VBA Excel

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Public ADigits(1 To 3, 1 To 20)
Public ADigitst(1 To 3) As String
Public Over10
Function StrSum(NSum) As String
'
'  in: nsum - сума(число)
' out: Сума прописом
'
' StrSum для m$ excel
'

Dim AKop(1 To 4)
Static AGrn(1 To 5, 1 To 5) As Variant
Static SSum, NKop, SGrn, NTriad, NTriads, st, CSum, ssgn

AKop(1) = "коп.": AKop(2) = "": AKop(3) = "": AKop(4) = ""
AGrn(1, 1) = "грн.": AGrn(1, 2) = "": AGrn(1, 3) = "": AGrn(1, 4) = "": AGrn(1, 5) = True
AGrn(2, 1) = "тисяч": AGrn(2, 2) = "а": AGrn(2, 3) = "i": AGrn(2, 4) = "": AGrn(2, 5) = True
AGrn(3, 1) = "мiльйон": AGrn(3, 2) = "": AGrn(3, 3) = "и": AGrn(3, 4) = "iв": AGrn(3, 5) = False
AGrn(4, 1) = "мiльярд": AGrn(4, 2) = "": AGrn(4, 3) = "и": AGrn(4, 4) = "iв": AGrn(4, 5) = False
AGrn(5, 1) = "трильйон": AGrn(5, 2) = "": AGrn(5, 3) = "и": AGrn(5, 4) = "iв": AGrn(5, 5) = False
ADigits(1, 1) = "": ADigits(1, 2) = "один": ADigits(1, 3) = "два": ADigits(1, 4) = "три"
ADigits(1, 5) = "чотири": ADigits(1, 6) = "п'ять": ADigits(1, 7) = "шiсть": ADigits(1, 8) = "сiм"
ADigits(1, 9) = "вiсiм": ADigits(1, 10) = "дев'ять": ADigits(1, 11) = "десять": ADigits(1, 12) = "оди"
ADigits(1, 13) = "два": ADigits(1, 14) = "три": ADigits(1, 15) = "чотир": ADigits(1, 16) = "п'ят"
ADigits(1, 17) = "шiст": ADigits(1, 18) = "сiм": ADigits(1, 19) = "вiсiм": ADigits(1, 20) = "дев'ят"
ADigits(2, 1) = "двадцять": ADigits(2, 2) = "тридцять": ADigits(2, 3) = "сорок"
ADigits(2, 4) = "п'ятдесят": ADigits(2, 5) = "шiстдесят": ADigits(2, 6) = "сiмдесят"
ADigits(2, 7) = "вiсiмдесят": ADigits(2, 8) = "дев'яносто"
ADigits(3, 1) = "": ADigits(3, 2) = "сто": ADigits(3, 3) = "двiстi": ADigits(3, 4) = "триста"
ADigits(3, 5) = "чотириста": ADigits(3, 6) = "п'ятсот": ADigits(3, 7) = "шiстсот"
ADigits(3, 8) = "сiмсот": ADigits(3, 9) = "вiсiмсот": ADigits(3, 10) = "дев'ятсот"
ADigitst(1) = "": ADigitst(2) = "одна": ADigitst(3) = "двi"
Over10 = "надцять"
CSum = ""

    If NSum < 0 Then
      ssgn = "Мінус "
    Else
      ssgn = ""
    End If
    NSum = Abs(NSum)
    SSum = LTrim(Format(NSum, "#################0.00"))
    NKop = Val(Right(SSum, 2))                    ' видiляю копiйки
    SGrn = Left(SSum, InStr(SSum, ",") - 1)       ' видiляю гривнi
' Debug.Print NSum
' debug.Print "коп.       —", NKop
' debug.Print "грн.       —", SGrn
' debug.Print "довжина    —", Len(SGrn)

' визначаю кiлькiсть трiад
    NTriads = Int(Len(SGrn) / 3) + IIf(Len(SGrn) Mod 3 <> 0, 1, 0)
' debug.Print "тріад      —", NTriads

    If Val(SGrn) > 0 Then           ' є гривні?
      SGrn = Space(NTriads * 3 - Len(SGrn)) + SGrn ' добавити пробіли неповній т.
      If NTriads <= UBound(AGrn) Then
' Debug.Print UBound(AGrn)
        For NTriad = NTriads To 1 Step -1
' видiляю трiаду
          st = Mid(SGrn, IIf(NTriads = NTriad, 1, (NTriads - NTriad) * 3 + 1), 3)
' debug.Print "тріада №,st,ind() —"; NTriad; st; ind(Val(Mid(st, 2))); _
            strtriad(st, AGrn(NTriad, 5)), AGrn(NTriad, ind(Val(Mid(st, 2))))
          CSum = CSum + IIf(st = "000", "", _
                    strtriad(st, AGrn(NTriad, 5)) + " " + _
                    AGrn(NTriad, 1) + AGrn(NTriad, ind(Val(Mid(st, 2)))) + " ")
        Next NTriad
' дописати назву грошової одиниці коли остання тріада '000'
         CSum = CSum + IIf(st = "000", AGrn(NTriad + 1, 1) + _
                                                        AGrn(NTriad + 1, ind(Val(st))) + " ", "")
' дописати копійки
' //      if nsum<1000
         CSum = ssgn + CSum + Format(NKop, "##00") + " " + AKop(1) + AKop(ind(NKop))
' //      endif
      Else
         StrSum = "дуже багато гривень"
      End If
       StrSum = CSum
' Debug.Print StrSum
     End If
 End Function
 Static Function strtriad(st, ltriad)
'  in: @st - адрес тріади
'   ltriad - .f. тріада чоловічого роду, .t. тріада жіночого роду
' out: тріада словами
'
  Static digit, t, c
  c = ""
     t = Val(st)
 ' Debug.Print "stt st,t,c  —"; st, t, c
     If t > 99 Then
       digit = Int(t / 100)
       c = ADigits(3, digit + 1) + " "
       t = t Mod 100            ' t%
     End If
 ' Debug.Print "stt t,c  —"; t, c
     If t > 19 Then
       digit = Int(t / 10)
       c = c + ADigits(2, digit - 1) + " "
       t = t Mod 10             ' t%
     End If
 ' Debug.Print "stt t,c  —"; t, c
     If (ltriad And t < 3) Then      ' трiада ж. роду
       c = c + ADigitst(t + 1)
     Else
       c = c + ADigits(1, t + 1) + IIf(t > 10, Over10, "")
     End If
 ' Debug.Print "==", t, c
     strtriad = c
 End Function
Static Function ind(n)
'   in: n - число                 // i - цiле число<20
'  out: iндекс закiнчення
'
Static i
    i = IIf(n < 20, n, n Mod 10)
    ind = IIf(i = 1, 2, IIf((i >= 2) And (i <= 4), 3, 4))       ' 2#
End Function

=-=-=-=-=
Powered by Blogilo

Advertisements

One Response to Перевтілення StrSum: VBA Excel

  1. Пінгбек: Кілька перевтілень StrSum() « Java це просто

Залишити відповідь

Заповніть поля нижче або авторизуйтесь клікнувши по іконці

Лого WordPress.com

Ви коментуєте, використовуючи свій обліковий запис WordPress.com. Log Out / Змінити )

Twitter picture

Ви коментуєте, використовуючи свій обліковий запис Twitter. Log Out / Змінити )

Facebook photo

Ви коментуєте, використовуючи свій обліковий запис Facebook. Log Out / Змінити )

Google+ photo

Ви коментуєте, використовуючи свій обліковий запис Google+. Log Out / Змінити )

З’єднання з %s

%d блогерам подобається це: