Datuve :: Forums :: Arhīvs :: Excela formula,kas pārveido skaitļu summu vārdos

Datuve

Mana Datuve

Reģistrācija | Noteikumi | Paroles atjaunošana



Forums

Ieskaties


Raksti

Lietotāji online

Lietotāji online: 68

Reģistrētie lietotāji online: 0

Viesi online: 68

Datuve.lv video
Top.LV

Excela formula,kas pārveido skaitļu summu vārdos

Ievietoja: zushix @ 2011.05.02 11:43  

Angļu valodā esmu atradis funkciju,kas pārveido summu dolāros un centos. Bet varbūt kādam ir funkcija kas pārveido summu latos un santīmos ?

Komentāri:

#1 karuuzo @ 2011.05.02 15:27

Eh, nemākam mēs meklēt :)
http://datuve.lv/forums/40933/Summa_vardiem_Exceli

m

#2 koreds @ 2011.05.18 11:44

Uztaisi šādu macros un viss notiek:

Sub NumberToString()
'
' NumberToString Macro
' Macro recorded 2007.08.13 by RegOnC
'

a0 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
A1 = Array("simt", "desmit")
b0 = Array(0, 0, 0)
b1 = ""

x0 = Array("", "viens", "divi", "trīs", "četri", "pieci", "seši", "septiņi", "astoņi", "deviņi")
x1 = Array("", "vien", "div", "trīs", "četr", "piec", "seš", "septiņ", "astoņ", "deviņ")

aResGroup = Array(b0, b0, b0, b0, b0, b0, b0, b0, b0)

ch0 = Selection.Value

If IsNull(ch0) Or _
   Not IsNumeric(ch0) Or _
   ch0 = "" Then
   MsgBox "Not Numeric or empty!"
   Exit Sub
Else
   ch0 = FormatNumber(Selection.Value, 2, vbFalse, vbFalse, vbFalse)
   If InStr(ch0, ".") Then
       aVal = Split(ch0, ".", -1, vbBinaryCompare)
   ElseIf InStr(ch0, ",") Then
       aVal = Split(ch0, ",", -1, vbBinaryCompare)
   Else
       aVal = Array(0, 0)
       aVal(0) = ch0
       aVal(1) = "00"
   End If
End If

aResGroup(8) = aVal(1)

Dim sTmp As String
sTmp = StrReverse(aVal(0))
iMod = 3 - (Len(sTmp) Mod 3)
For i = 1 To iMod
   sTmp = sTmp & "0"       'Pievieno nulles galā, lai ciparu rinda dalaas uz 3 bez atlikuma
Next

i = 1
n = 1
m = Len(sTmp)
Do While i < m
   For j = 0 To 2
       aResGroup(n)(j) = Mid(sTmp, m - i + 1, 1)
       i = i + 1
       If i > m Then
           Exit For
           Exit Do
       End If
   Next
   n = n + 1
Loop

m = n
sTmp = ""

For i = 1 To n - 1
   'MsgBox "aResGroup(i)(0): " & aResGroup(i)(0)
   If aResGroup(i)(0) = 0 Then
       s100 = 0
   Else
       s100 = CInt(aResGroup(i)(0))
   End If
   
   'MsgBox "aResGroup(i)(1): " & aResGroup(i)(1)
   If aResGroup(i)(1) = 0 Then
       s10 = 0
   Else
       s10 = CInt(aResGroup(i)(1))
   End If
   
   'MsgBox "aResGroup(i)(2): " & aResGroup(i)(2)
   If aResGroup(i)(2) = 0 Then
       s1 = 0
   Else
       s1 = CInt(aResGroup(i)(2))
   End If
       
   'MsgBox "Digit group " & i & " = " & s100 & s10 & s1
       
   Select Case s100
       Case 0: sRes100 = ""
       Case 1: sRes100 = "simts"
       Case Else: sRes100 = x0(s100) & " simti"
   End Select
   
   Select Case s10
       Case 0:
               sRes10 = ""
               sPadsmit = False
       Case 1:
           Select Case s1
               Case 0:
                   sRes10 = "desmit"
                   sPadsmit = False
               Case Else:
                   sRes10 = x1(s1) & "padsmit"
                   sPadsmit = True
           End Select
       Case Else:
               sRes10 = x1(s10) & "desmit"
               sPadsmit = False
   End Select
   
   Select Case s1
       Case 0: sRes1 = ""
       Case Else:
           Select Case sPadsmit
               Case False: sRes1 = x0(s1)
               Case True: sRes1 = ""
           End Select
   End Select
   
   m = m - 1
   
   If aResGroup(i)(0) = 0 And _
      aResGroup(i)(1) = 0 And _
      aResGroup(i)(2) = 0 Then
       sTmp = ""
   Else
       Select Case m
            Case 6:
               Select Case s1
                   Case 1: sTmp = "kvadriljons"
                   Case Else: sTmp = "kvadriljoni"
               End Select
           Case 5:
               Select Case s1
                   Case 1: sTmp = "triljons"
                   Case Else: sTmp = "triljoni"
           End Select
           Case 4:
               Select Case s1
                   Case 1: sTmp = "miljards"
                   Case Else: sTmp = "miljardi"
               End Select
           Case 3:
               Select Case s1
                   Case 1: sTmp = "miljons"
                   Case Else: sTmp = "miljoni"
               End Select
           Case 2:
               Select Case s1
               Case 1: sTmp = "tūkstotis"
               Case Else: sTmp = "tūkstoši"
           End Select
           Case Else: sTmp = ""
       End Select
   End If
   sResAll = sResAll & sRes100 & " " & sRes10 & " " & sRes1 & " " & sTmp & " "
Next

sTmp = Trim(aResGroup(8))
iLen = Len(sTmp)

iMod = 2 - (Len(sTmp) Mod 2)
For i = 1 To iMod
   sTmp = sTmp & "0"
Next

iDec = 10
sSant = 0
For i = 1 To 2
   sSant = sSant + iDec * Mid(sTmp, i, 1)
   iDec = iDec / 10
Next

sResAll = sResAll & "lati, " & sSant & " santīmi"

For i = 1 To Len(sResAll)
   sResAll = Replace(sResAll, "  ", " ", 1, 1, 1)
Next

sResAll = LTrim(sResAll)

UserForm1.TextBox1 = sResAll
UserForm1.Show

End Sub