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 ' 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)
' 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.335 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Neu! sevEingabe 3.0 Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. |
||||||||||||||||
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. |