vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
NEU! sevCoolbar 2.0 - Professionelle Toolbars im modernen Design!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2017
 
zurück
Rubrik: Variablen/Strings · Arrays   |   VB-Versionen: VB6, VBA04.04.16
Zwei spezielle Array-Funktionen (VB6, VBA, Word2007)

Der Tipp zeigt 2 spezielle Funktionen zur Verwendung mit Arrays.

Autor:   Dietrich HerrmannBewertung:     [ Jetzt bewerten ]Views:  1.565 
ohne HomepageSystem:  Vista, Win7, Win8, Win10kein Beispielprojekt 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise bis zu 120,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 479,20 EUR statt 599,- EUR
  • sevDTA 3.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 20,00 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 55,20 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    Es handelt sich um 2 Funktionen, die auf Arrays in VB6/VBA angewendet werden können.

    1. Ermitteln der Anzahlen von mehrfach vorkommenden Elementen in einem eindimensionalen Array
    Die Funktion ermittelt die Anzahl von mehrfach vorkommenden Elementen in einem gegebenen Array. Dabei muss das Array, zumindest temporär, sortiert sein. Es wird ein zweidimensionales Array zurückgegeben, das den Wert und dessen ermittelte Anzahl enthält.

    ' Ermitteln der Anzahlen von mehrfach vorkommenden Elementen 
    ' in einem eindimensionalen Array
    ' arr: das zu untersuchende Array (muss sortiert sein!)
    ' Rückgabe: Array (zweidimensional) mit den Paaren 'Wert und Anzahl'
    ' gemäß der Reihenfolge der Werte im sortierten Original-Array
    Public Function getValAndNumberOfeqElements2(arr As Variant) As Variant
      Dim Temp() As Variant, i, j, z As Integer, lastV, actV As Variant
      i = 0
      ReDim Temp(1, 1)
      For Each actV In arr
        If lastV = "" Or lastV <> actV Then
          z = 1
          ReDim Preserve Temp(1, i)
          Temp(0, i) = actV
          Temp(1, i) = z
          lastV = actV
          j = i
          i = i + 1
        Else
          z = z + 1
          Temp(1, j) = z
        End If
      Next 
      getValAndNumberOfeqElements2 = Temp
    End Function

    2. Elemente zweier Arrays mit arithmetischer Operation verknüpfen (Sonderfall Verknüfung mit Konstante)
    Diese Funktion ist geeignet, die Elemente zweier Arrays mittels arithmetischer Operation (Addition, Subtraktion, Multiplikation, Division) zu verknüpfen, also ein "Ergebnis-Array" zu berechnen. Es gibt ein paar Vorbedingungen:

    • die beiden Arrays müssen gleich lang sein, also dieselbe Anzahl von Elementen besitzen,
    • die Arrays sollten möglichst denselben Datentyp beinhalten,
    • es ist nur möglich Array mit Array oder Array mit Konstante zu verknüpfen.
    ' Elemente zweier Arrays mit arithmetischer Operation verknüpfen
    ' arithArt: die Operation als String ("+", "-", "*", "/")
    ' arr1: das erste Array
    ' arr2: das zweite Array
    ' idx1: Anfangsindex (optional angebbar)
    ' idx2: Endeindex (optional angebbar)
    ' constante: eine Konstante
    ' Rückgabe: das Ergebnis-Array
    '
    ' Das zweite Array muss bei Subtraktion die Subtrahenden,
    ' bei Division die Divisoren als Elemente enthalten.
    ' Wird ein zweites Array nicht angegeben, wird erwartet,
    ' dass mit einer Konstanten gerechnet wird.
    ' Es wird anhand des ersten Array-Elements überprüft, 
    ' ob es numerische Elemente sind,
    ' wenn nicht, wird als Ergebniselement 0 gespeichert.
    Public Function arithArrays(arithArt As String, _
      arr1 As Variant, Optional arr2 As Variant, _
      Optional idx1 As Integer, Optional idx2 As Integer, _
      Optional constante As Variant) As Variant
     
      If IsMissing(idx1) Then idx1 = 0: If IsMissing(idx2) Then idx2 = 0
      If IsMissing(constante) Then constante = 0
     
      Dim value As Variant
      Dim bCalc As Boolean
     
      ' Ausgabe-Array
      Dim tmpArr() As Variant   ' das erste Feld bestimmt die Dimension des Ausgabefelds
      ReDim tmpArr(UBound(arr1) + 1)
      Dim lastIdx As Integer
     
      lastIdx = idx2
      If idx2 = 0 Then lastIdx = UBound(arr1)
      ' prüfen, ob Felder oder Konstante numerisch sind
      If Not IsNumeric(arr1(0)) Then Exit Function
      If Not IsMissing(arr2) Then If Not IsNumeric(arr2(0)) Then Exit Function
      If Not IsMissing(constante) Then If Not IsNumeric(constante) Then Exit Function
     
      For i = idx1 To lastIdx
        bCalc = True
        If Not IsMissing(arr2) Then     ' Rechnen mit zwei Feldern
          If IsNull(arr1(i)) Or IsNull(arr2(i)) Then 
            bCalc = False
          ElseIf Not IsNumeric(arr1(i)) Or Not IsNumeric(arr2(i)) Then
            ' Arrayelement war nicht numerisch (könnte auch DBNull oder 
            ' Nothing o.ä. gesetzt werden)
            tmpArr(i) = 0
            bCalc = False
          Else
            value = arr2(i)
          End If
     
        Else            ' Rechnen mit Konstante
          If Not IsNumeric(arr1(i)) Then
            ' Arrayelement war nicht numerisch, dann Ergebniselement = Originalelement
            tmpArr(i) = arr1(i)
            bCalc = False
          Else
            value = constante
          End If
        End If
     
        If bCalc Then
          Select Case arithArt
            Case "+"        ' Addition
              tmpArr(i) = arr1(i) + value
            Case "-"        ' Subtraktion
              tmpArr(i) = arr1(i) - value
            Case "*"        ' Multiplikation
              tmpArr(i) = arr1(i) * value
            Case "/"        ' Division
              If value = 0 Then
                ' wenn Divisorelement oder constante =0, dann Ergebniselement =0
                ' (könnte auch =DBNull oder =Nothing oder =Originalelement von 
                ' arr1 o.ä. gesetzt werden)
                tmpArr(i) = 0
              Else
                tmpArr(i) = arr1(i) / value
              End If
          End Select
        End If
      Next i
      arithArrays = tmpArr
    End Function

    Desweiteren veröffentliche ich zwei Hilfsfunktionen zum Debuggen von eindimensionalem bzw. zweidimensionalem Array, d.h., Ausgabe der Arrayelemente inkl. Index im Direktfenster.

    Public Sub debugArray(theArray As Variant)
      Dim i As Integer
      For i = 0 To UBound(theArray)
        Debug.Print (CStr(i) + " - " + CStr(theArray(i)))
      Next 
    End Sub
    Public Sub debugArray2(theArray As Variant)
      Dim i As Integer
      For i = 0 To UBound(theArray, 2)
        Debug.Print (CStr(theArray(0, i)) + " - " + CStr(theArray(1, i)))
      Next 
    End Sub

    Dieser Tipp wurde bereits 1.565 mal aufgerufen.

    Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

    Über diesen Tipp im Forum diskutieren
    Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

    Neue Diskussion eröffnen

    nach obenzurück


    Anzeige

    Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6

    Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
    - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
    - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
    Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
     
       

    Druckansicht Druckansicht Copyright ©2000-2017 vb@rchiv Dieter Otter
    Alle Rechte vorbehalten.
    Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

    Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel