Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Klassenprogrammierung: Factory-Klasse
zurück: Beim Kopieren immer nur Werte einfügen weiter: Dictionary selbst gemacht Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Tutorial Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Isabelle :-)
Menschin


Verfasst am:
17. Feb 2014, 20:57
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis

Klassenprogrammierung: Factory-Klasse - Klassenprogrammierung: Factory-Klasse

Nach oben
       Version: Office 2k (2000)

Hallöchen,

was ist denn das schon wieder? Naja, was ist eine Fabrik? Etwas das vorne mit Rohstoffen beliefert wird und hinten fertige Produkte ausspuckt. Also im Prinzip eine Funktion der ich Werte übergebe und mir daraus etwas "neues" zurück gibt. Wozu dann eine Klasse? Weil ich einer Klasse nur einmal die Werte übergeben muss und dann die verschiedenen "Endprodukte" abrufen kann.

Und so funktioniert das:

Wir brauchen ein Klassenmodul mit einer Funktion, welche uns eine Instanz von sich selbst zurück gibt, mit der wir dann wieder die Eigenschaften der Klasse abrufen können.


Dazu müssen wir, weil wir die Klasse wie eine Funktion benutzen wollen, die VB_PredeclaredId- Eigenschaft der Klasse ändern.

Wie das geht ist hier beschrieben: http://www.office-loesung.de/ftopic618585_0_0_asc.php

Und so sieht das Ganze dann aus:

In einem Klassenmodul mit dem Namen "WorksheetFunctionFactory":

Code:
Option Explicit

Private Const MIN_VALUE As Double = -4.94065645841247E-324
Private Const MAX_VALUE As Double = 1.79769313486231E+308

Private mvntValues() As Variant

Friend Function Values(ParamArray pavntValue() As Variant) As WorksheetFunctionFactory
    Set Values = Me
    If Not IsMissing(pavntValue) Then mvntValues() = pavntValue()
End Function

Friend Property Get MAX() As Variant
    Dim iavntItem As Variant
    MAX = MIN_VALUE
    For Each iavntItem In mvntValues(0)
        If iavntItem > MAX Then MAX = iavntItem
    Next
End Property

Friend Property Get MIN() As Variant
    Dim iavntItem As Variant
    MIN = MAX_VALUE
    For Each iavntItem In mvntValues(0)
        If iavntItem < MIN Then MIN = iavntItem
    Next
End Property

Friend Property Get MINNOZERO() As Variant
    Dim iavntItem As Variant
    MINNOZERO = MAX_VALUE
    For Each iavntItem In mvntValues(0)
        If iavntItem > 0 Then If iavntItem < MINNOZERO Then _
            MINNOZERO = iavntItem
    Next
End Property

Friend Property Get COUNT() As Variant
    Dim iavntItem As Variant
    For Each iavntItem In mvntValues(0)
        If Not IsEmpty(iavntItem) Then COUNT = COUNT + 1
    Next
End Property

Friend Property Get COUNTNOZERO() As Variant
    Dim iavntItem As Variant
    For Each iavntItem In mvntValues(0)
        If iavntItem > 0 Then COUNTNOZERO = COUNTNOZERO + 1
    Next
End Property

Friend Property Get SUM() As Variant
    Dim iavntItem As Variant
    For Each iavntItem In mvntValues(0)
        SUM = SUM + iavntItem
    Next
End Property

Friend Property Get AVERAGE() As Variant
    AVERAGE = SUM / COUNTNOZERO
End Property

Friend Property Get MATCH(ByVal pvvntSerachTerm As Variant) As Variant
    Dim iavntItem As Variant
    Dim lngCount As Long
    MATCH = CVErr(xlErrNA)
    lngCount = LBound(mvntValues(0)) - 1
    For Each iavntItem In mvntValues(0)
        lngCount = lngCount + 1
        If iavntItem = pvvntSerachTerm Then
            MATCH = lngCount
            Exit For
        End If
    Next
End Property

Friend Property Get VLOOKUP(ByVal pvvntSerachTerm As Variant) As Variant
    Dim lngRow As Long
    VLOOKUP = CVErr(xlErrNA)
    For lngRow = 1 To UBound(mvntValues(0))
        If mvntValues(0)(lngRow, 1) = pvvntSerachTerm Then
            VLOOKUP = mvntValues(1)(lngRow, 1)
            Exit For
        End If
    Next
End Property


In einem Standardmodul:

Code:
Option Explicit

Public Sub Test()

    Dim avntArray As Variant

    avntArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0)



    'Max aus übergebenen Array
    Debug.Print WorksheetFunctionFactory.Values(avntArray).MAX

    'Min ohne 0 aus vorher übergebenen Array
    Debug.Print WorksheetFunctionFactory.Values.MINNOZERO



    'Max aus übergebenen Range
    Debug.Print WorksheetFunctionFactory.Values(Union(Range("A1:A10"), Range("C1:C10"))).MAX

    'Min ohne 0 aus dem vorher übergebenen Range
    Debug.Print WorksheetFunctionFactory.Values.MINNOZERO

    'Anzahl aus dem vorher übergebenen Range
    Debug.Print WorksheetFunctionFactory.Values.COUNT

    'Anzahl ohne 0 aus dem vorher übergebenen Range
    Debug.Print WorksheetFunctionFactory.Values.COUNTNOZERO

    'Summe aus dem vorher übergebenen Range
    Debug.Print WorksheetFunctionFactory.Values.SUM

    'Durchschnitt aus dem vorher übergebenen Range
    Debug.Print WorksheetFunctionFactory.Values.AVERAGE



    'Position (Index) des Wertes 5 im Array (0-basiert)
    Debug.Print WorksheetFunctionFactory.Values(avntArray).MATCH(5)

    'Position (Index) des Wertes 9 im Array (0-basiert)
    Debug.Print WorksheetFunctionFactory.Values.MATCH(5)



    'Position (Zeile) des Wertes 14 im übergebenen Range
    Debug.Print WorksheetFunctionFactory.Values(Range("A1:A10").Value).MATCH(14)

    'Position (Zeile) des Wertes 55 im vorher übergebenen Range (nicht vorhanden = Fehler NV# ~ Fehler 2042)
    Debug.Print WorksheetFunctionFactory.Values.MATCH(55)



    'Sverweis (nur Range) nach rechts - Suche die 14 in Spalte A und gib den Wert aus Spalte C der selben Zeile zurück
    Debug.Print WorksheetFunctionFactory.Values(Range("A1:A10").Value, Range("C1:C10").Value).VLOOKUP(14)

    'Sverweis (nur Range) nach rechts - Suche die 12 in Spalte A und gib den Wert aus Spalte C der selben Zeile zurück
    Debug.Print WorksheetFunctionFactory.Values.VLOOKUP(12)



    'Sverweis nach links - Suche die 4 in Spalte C und gib den Wert aus Spalte A der selben Zeile zurück
    Debug.Print WorksheetFunctionFactory.Values(Range("C1:C10").Value, Range("A1:A10").Value).VLOOKUP(4)

    'Sverweis nach links - Suche die 8 in Spalte C und gib den Wert aus Spalte A der selben Zeile zurück
    Debug.Print WorksheetFunctionFactory.Values.VLOOKUP(8)

End Sub


Die Funktionen der Klasse sind einfache Beispiele um die langsamen WorksheetFunktion-Methoden durch schnellere VBA-Eigenschaften zu ersetzen.

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%


Zuletzt bearbeitet von Isabelle :-) am 18. Feb 2014, 09:03, insgesamt 3-mal bearbeitet
Isabelle :-)
Menschin


Verfasst am:
19. Feb 2014, 01:17
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis


AW: Klassenprogrammierung: Factory-Klasse - AW: Klassenprogrammierung: Factory-Klasse

Nach oben
       Version: Office 2k (2000)

Und hier noch meine Testdaten:

Arbeitsblatt mit dem Namen 'Tabelle1'
 ABC
120 10
219 9
318 8
417 7
50 6
6  5
714 4
813 3
912 2
1011 1

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
Isabelle :-)
Menschin


Verfasst am:
19. Feb 2014, 01:19
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis

AW: Klassenprogrammierung: Factory-Klasse - AW: Klassenprogrammierung: Factory-Klasse

Nach oben
       Version: Office 2k (2000)

Achso,

wenn du Vorschläge für Verbesserungen oder Ergänzungen hast, immer her damit (per PM). Ich werde die dann unter Nennung des Autors einbauen.

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
Isabelle :-)
Menschin


Verfasst am:
25. Feb 2014, 19:30
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis


AW: Klassenprogrammierung: Factory-Klasse - AW: Klassenprogrammierung: Factory-Klasse

Nach oben
       Version: Office 2k (2000)

Hallöchen,

ich hab eine neue: COUNTIFS

In der Klasse:

Code:
Friend Property Get COUNTIFS(ParamArray pvvntSerachTerm() As Variant) As Variant
    Dim ialngIndex As Long, lngRow As Long
    Dim blnFound As Boolean
    For lngRow = 1 To UBound(mavntValues(0))
        If mavntValues(0)(lngRow, 1) = pvvntSerachTerm(0) Then
             blnFound = True
            For ialngIndex = 1 To UBound(pvvntSerachTerm)
                If mavntValues(ialngIndex)(lngRow, 1) <> pvvntSerachTerm(ialngIndex) Then
                    blnFound = False
                    Exit For
                End If
            Next
            COUNTIFS = COUNTIFS + blnFound * -1
        End If
    Next
End Property


Der Aufruf:

Code:
    'Zählenwenns der Spalte A,C,E über 100.000 Zeilen nach a,b,c
    Debug.Print WorksheetFunctionFactory.Values(Tabelle2.Range("A1:A10000").Value2, _
        Tabelle2.Range("C1:C10000").Value2, Tabelle2.Range("E1:E10000").Value2).COUNTIFS("a", "b", "c")
       
    'Zählenwenns der Spalte A,C,E über 100.000 Zeilen nach v,y,z
    Debug.Print WorksheetFunctionFactory.Values.COUNTIFS("v", "y", "z")

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Microsoft Project