vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Mails senden, abrufen und decodieren - ganz easy ;-)  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
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:  6.314 
ohne HomepageSystem:  Win7, Win8, Win10, Win11kein Beispielprojekt 

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 6.314 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-2024 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