Tipp 0352 Rechnen mit großen Zahlen
Autor/Einsender:
Datum:
  Sebastian Bauersfeld
14.08.2003
Entwicklungsumgebung:   VB 6
Das Beispiel soll zeigen, wie man mit Hilfe von Strings auch (natürliche) Zahlen miteinander addieren, subtrahieren und auch multiplizieren kann, die nicht in den Wertebereich von Integer-, Long-, oder sogar Double-Variablen passen.
Funktionen:
-  Absoluter Wert
-  Vorzeichen ermitteln
-  Zahl "säubern"
-  Vergleich zweier Zahlen
-  Addition
-  Subtraktion
-  Multiplikation
Dieses Beispiel ist alles andere als optimiert. Es wird nur Wert darauf gelegt, die Funktionsweise aufzuzeigen. Gerade bei der Multiplikation gibt es auch schnellere Varianten, hier soll lediglich eine einfache Möglichkeit aufgezeigt werden.
 
Option Explicit

'Erweiterte Format-Funktion
Private Function HFormat(ByRef Expression As String, _
      ByRef Format As String) As String

  If Len(Expression) > Len(Format) Then
    HFormat = Expression
  Else
    HFormat = Left(Format, Len(Format) - Len(Expression)) & _
          Expression
  End If
End Function

' Bereinigt eine Zahl (entfernt vorangestellte Nullen,
' Pluszeichen und nichtnumerische Zeichen)
Public Function HPurgeNum(ByVal Num As String) As String
  Dim n       As Long
  Dim Char    As String

  HPurgeNum = ""

  For n = 1 To Len(Num)
    Char = Mid(Num, n, 1)

    If IsNumeric(Char) Then
      If Char <> "0" Or (Len(HPurgeNum) > 0 And _
            HPurgeNum <> "-") Then HPurgeNum = HPurgeNum & Char
    Else
      If Len(HPurgeNum) = 0 And Char = "-" Then _
            HPurgeNum = HPurgeNum & Char
    End If
  Next

  If HPurgeNum = "" Or HPurgeNum = "-" Then HPurgeNum = "0"
End Function

'Gibt den absoluten Wert einer Zahl zurück
Public Function HAbs(ByVal Num As String) As String
  If Left(Num, 1) = "-" Then
    HAbs = Right(Num, Len(Num) - 1)
  Else
    HAbs = Num
  End If
End Function

'Gibt das Vorzeichen einer Zahl zurück (-1 oder 1)
Public Function HSgn(ByVal Num As String) As Integer
  If Left(Num, 1) = "-" Then
    HSgn = -1
  Else
    HSgn = 1
  End If
End Function

 ' Vergleicht die Größe zweier Zahlen
 ' 0 = gleich groß
 ' 1 = Zahl eins ist größer
 ' 2 = Zahl zwei ist größer
Public Function HCmp(ByVal Num1 As String, _
      ByVal Num2 As String) As Integer

  If Num1 = Num2 Then
    HCmp = 0

  ElseIf HSgn(Num1) > HSgn(Num2) Then
    HCmp = 1

  ElseIf HSgn(Num1) < HSgn(Num2) Then
    HCmp = 2

  ElseIf Len(Num1) > Len(Num2) Then
    If HSgn(Num1) = 1 Then
      HCmp = 1
    Else
      HCmp = 2
    End If

  ElseIf Len(Num1) < Len(Num2) Then
    If HSgn(Num1) = 1 Then
      HCmp = 2
    Else
      HCmp = 1
    End If

  Else
    Dim n       As Long
    Dim dSign   As Integer

    dSign = HSgn(Num1)
    Num1 = HAbs(Num1)
    Num2 = HAbs(Num2)

    For n = 1 To Len(Num1)
      If CInt(Mid(Num1, n, 1)) > CInt(Mid(Num2, n, 1)) Then
        If dSign = 1 Then
          HCmp = 1
        Else
          HCmp = 2
        End If

        Exit Function

      ElseIf CInt(Mid(Num1, n, 1)) < CInt(Mid(Num2, n, 1)) Then
        If dSign = 1 Then
          HCmp = 2
        Else
          HCmp = 1
        End If
        Exit Function
      End If

    Next
  End If
End Function

'Addition
Public Function HAdd(ByVal Num1 As String, _
      ByVal Num2 As String) As String

  Dim n        As Long
  Dim Sgn1     As Integer
  Dim Sgn2     As Integer
  Dim SgnRes   As Integer
  Dim Cipher   As Integer
  Dim Expand   As Integer

  Sgn1 = HSgn(Num1)
  Sgn2 = HSgn(Num2)
  Num1 = HAbs(Num1)
  Num2 = HAbs(Num2)

  If HCmp(Num1, Num2) = 1 Then
    SgnRes = Sgn1
  Else
    SgnRes = Sgn2
  End If

  If Len(Num1) > Len(Num2) Then
    Num2 = HFormat(Num2, String(Len(Num1), "0"))
    HAdd = String(Len(Num1) + 1, "0")
  Else
    Num1 = HFormat(Num1, String(Len(Num2), "0"))
    HAdd = String(Len(Num2) + 1, "0")
  End If

  Expand = 0

  If Sgn1 = Sgn2 Then

    For n = Len(Num1) To 1 Step -1
      Cipher = _
          CInt(Mid(Num1, n, 1)) + CInt(Mid(Num2, n, 1)) + Expand

      If Cipher > 9 Then
        Cipher = Cipher - 10
        Expand = 1
      Else
        Expand = 0
      End If

      Mid(HAdd, Len(HAdd) - (Len(Num1) - n), 1) = CStr(Cipher)
    Next

    Mid(HAdd, Len(HAdd) - (Len(Num1) - n), 1) = CStr(Expand)

  Else

    If Num1 > Num2 Then
      For n = Len(Num1) To 1 Step -1
        Cipher = _
            CInt(Mid(Num1, n, 1)) - CInt(Mid(Num2, n, 1)) - Expand

        If Cipher < 0 Then
          Cipher = Cipher + 10
          Expand = 1
        Else
          Expand = 0
        End If

        Mid(HAdd, Len(HAdd) - (Len(Num1) - n), 1) = CStr(Cipher)
      Next

    Else
      For n = Len(Num1) To 1 Step -1
        Cipher = _
            CInt(Mid(Num2, n, 1)) - CInt(Mid(Num1, n, 1)) - Expand

        If Cipher < 0 Then
          Cipher = Cipher + 10
          Expand = 1
        Else
          Expand = 0
        End If

        Mid(HAdd, Len(HAdd) - (Len(Num1) - n), 1) = CStr(Cipher)
      Next

    End If
  End If

  If SgnRes = -1 Then HAdd = "-" & HAdd

  HAdd = HPurgeNum(HAdd)
End Function

'Subtraktion
Public Function HSubtract(ByVal Num1 As String, _
      ByVal Num2 As String) As String

  If HSgn(Num2) = -1 Then
    HSubtract = HAdd(Num1, HAbs(Num2))
  Else
    HSubtract = HAdd(Num1, "-" & Num2)
  End If
End Function

'Multiplikation
Public Function HMultiply(ByVal Num1 As String, _
      ByVal Num2 As String) As String

  Dim SgnRes      As String
  Dim Cipher1     As Long
  Dim Cipher2     As Long
  Dim n           As Long
  Dim m           As Long

  HMultiply = "0"
 
  SgnRes = ""
  If HSgn(Num1) * HSgn(Num2) = -1 Then SgnRes = "-"

  Num1 = HAbs(Num1)
  Num2 = HAbs(Num2)

  For n = Len(Num1) To 1 Step -1
    Cipher1 = CLng(Mid(Num1, n, 1))

    For m = Len(Num2) To 1 Step -1
      Cipher2 = CLng(Mid(Num2, m, 1))
      HMultiply = HAdd(HMultiply, CStr(Cipher1 * Cipher2) & _
            String(Len(Num1) - n + Len(Num2) - m, "0"))
    Next
  Next

  HMultiply = SgnRes & HMultiply
End Function
 

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (5,9 kB) Downloads bisher: [ 832 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Freitag, 16. September 2011