Rubrik: Variablen/Strings · Arrays | VB-Versionen: VB6, VBA | 04.04.16 |
Zwei spezielle Array-Funktionen (VB6, VBA, Word2007) Der Tipp zeigt 2 spezielle Funktionen zur Verwendung mit Arrays. | ||
Autor: Dietrich Herrmann | Bewertung: | Views: 6.335 |
ohne Homepage | System: Win7, Win8, Win10, Win11 | kein 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