Funktion funktioniert falsch

Fred · 2024-05-20T20:08:41+00:00

Hallo Excel Profis, den ganzen Nachmittag an diesem Ding und nun muss ich doch im Forum um Hilfe bitten. Ich habe eine Funktion, die die "Zwischenstände" eines Spiels in Zellen einfügt. Die Funktion macht ihren Fehler, wenn eine der Zellen - auf die sich bezogen wird - eine Leerzelle ist. Kann ein Profi bitte mal drauf schaun und lösen: https://www.herber.de/bbs/user/169592.xlsb die Function: Function Zwischenstand(GU As String, GV As String, n As Integer) As String Dim GUArray() As String, GVArray() As String Dim Treffers() As String Dim i As Integer, j As Integer Dim ToreA As Integer, ToreB As Integer Dim TreffersCount As Integer ' GU-Werte in ein Array aufteilen If GU > "" Then GUArray = Split(GU, " ") Else ReDim GUArray(0) GUArray(0) = "1E+99" ' Ein sehr großer Wert, falls GU leer ist End If ' GV-Werte in ein Array aufteilen If GV > "" Then GVArray = Split(GV, " ") Else ReDim GVArray(0) GVArray(0) = "1E+99" ' Ein sehr großer Wert, falls GV leer ist End If ' Kombiniere beide Arrays ReDim Treffers(UBound(GUArray) + UBound(GVArray) + 1) TreffersCount = 0 For i = 0 To UBound(GUArray) Treffers(TreffersCount) = GUArray(i) & "A" TreffersCount = TreffersCount + 1 Next i For i = 0 To UBound(GVArray) Treffers(TreffersCount) = GVArray(i) & "B" TreffersCount = TreffersCount + 1 Next i ' Sortiere das kombinierte Array For i = 0 To TreffersCount - 2 For j = i + 1 To TreffersCount - 1 If Val(Treffers(i)) > Val(Treffers(j)) Then Dim temp As String temp = Treffers(i) Treffers(i) = Treffers(j) Treffers(j) = temp End If Next j Next i ' Zähle die Tore bis zum n-ten Treffer ToreA = 0 ToreB = 0 For i = 0 To n - 1 ' Nur die ersten n Treffer berücksichtigen If i = UBound(Treffers) Then If Right(Treffers(i), 1) = "A" Then ToreA = ToreA + 1 ElseIf Right(Treffers(i), 1) = "B" Then ToreB = ToreB + 1 End If End If Next i ' Ergebnis nun zurückgeben Zwischenstand = ToreA & "-" & ToreB End Function Gruss Fred

Hallo Onur,
wie oft warst du nun schon mein "Problemlöser" ...
Vielen Dank!
Deine Function hat zwar nur unter der Bedingung gefunzt, das die Zahlen durch Komma getrennt sind- was ja nicht der Fall war - aber entsprechend geändert werden können .....
Mein Gemurgse trennt die Eingabedaten durch Leerzeichen.
Möglicherweise wird in meiner angepassten Version mögliche Leerzellen besser behandelt, indem sie überprüft, ob die Elemente in den Arrays leer sind, bevor sie verarbeitet werden. Das soll Fehler vermeiden,- bei der Umwandlung von leeren Strings in Zahlen (CInt). Weiter habe ich nun eine Fehlerbehandlung, die überprüft, ob überhaupt gültige Einträge vorhanden sind. Wenn keine gültigen Einträge vorhanden sind, wird 0-0 zurückgegeben und die Funktion beendet. Dies verhindert, dass eine leere Eingabe ein unerwartetes Ergebnis erzeugt....
In der angepassten Version werden Arrays direkt mit den relevanten Daten initialisiert und sortiert. Die Sortierung wurde optimiert, indem eine Schleife über die Elemente durchgeführt wird, was die Effizienz des Codes verbessert (oder?)
Gut möglich, daß die angepasste Version robuster gegenüber Eingabefehlern und ungewöhnlichen Fällen, wie leeren Eingabewerte in den Spalten GU und GV ist.

Ich bin dir jedenfalls sehr dankbar für deine Mühe und bereitgestellte Kompetenz!!!
Jetzt gehe ich ins Bett ...
angepasste Vers.:

Public Function ZWS(m1 As String, m2 As String, nr As Integer) As String

    Dim z As Variant, arr() As Integer, anz As Integer, anzz As Integer

    Dim u As Integer, zz As Integer, temp As Integer, erg(1 To 2) As Integer

    Dim i As Integer

    Dim m1Array As Variant, m2Array As Variant    



    m1Array = Split(m1, " ")

    m2Array = Split(m2, " ")    

    anz = 0

    For i = LBound(m1Array) To UBound(m1Array)

        If m1Array(i) > "" Then

            ReDim Preserve arr(1, anz)

            arr(0, anz) = CInt(m1Array(i)) * 10 + 1

            anz = anz + 1

        End If

    Next i

    

    anzz = anz

 

    For i = LBound(m2Array) To UBound(m2Array)

        If m2Array(i) > "" Then

            ReDim Preserve arr(1, anz)

            arr(0, anz) = CInt(m2Array(i)) * 10 + 2

            anz = anz + 1

        End If

    Next i

    

    If anz = 0 Then

        ZWS = "0-0"

        Exit Function

    End If

    

    u = UBound(arr, 2)

    For i = 0 To u

        For zz = i + 1 To u

            If arr(0, i) > arr(0, zz) Then

                temp = arr(0, zz)

                arr(0, zz) = arr(0, i)

                arr(0, i) = temp

            End If

        Next zz

    Next i

    

    For i = 0 To WorksheetFunction.Min(nr - 1, UBound(arr, 2))

        erg(arr(0, i) Mod 10) = erg(arr(0, i) Mod 10) + 1

    Next i

    

    ZWS = erg(1) & "-" & erg(2)

    If nr > (erg(1) + erg(2)) Then ZWS = ""

End Function

aufruf, zB:

=ZWS(GU4; GV4; 1)

Gruss
Fred

Im Prinzip hat dein Code nur ein paar kleine Schwächen.
Das ist ja eine Funktion und wenn du da erste lange Array sortierst, um dann 0-0 auszugeben, dann ist das nicht effizient.
Dann hast du halt auch noch dieses Dummy da eingebaut, mit 1E+99, das du dann aber als Tor mit zählst.
Wenn z.B. A keine Tore geschossen hat, dann ist es doch nicht notwendig irgend eine Sortierung zu machen, oder?
Du musst nur prüfen, inwieweit B schon mehr oder weniger als n Tore geschossen hat.....usw.
Wenn keiner ein Tor geschossen hat, kann n so groß sein wie es will, es kommt 0-0 raus.
Ich hab mal etwas in deinem Code herum gewütet, naja, viel ist nicht geblieben.
Hab das jetzt aber auch nicht ausführlich getestet:



Public Function Zwischenstand(strA As String, strB As String, n As Long) As String

    

             

    If n = 0 Then

    

        Zwischenstand = "0 - 0"

        Exit Function



    End If

    

    Dim aR() As String

    

    If Trim(strA) = "" Or Trim(strB) = "" Then

        If Trim(strA) = "" And Trim(strB) = "" Then

            

            Zwischenstand = "0 - 0"

            Exit Function

        

        End If

        If Trim(strB) = "" Then

            aR = Split(strA, " ")

            

            If n - 1 >= UBound(aR) Then

                Zwischenstand = UBound(aR) + 1 & "-0"

            Else

                Zwischenstand = n & "-0"

            End If

            Exit Function

        

        Else

            aR = Split(strB, " ")

          

            If n - 1 >= UBound(aR) Then

                Zwischenstand = "0-" & UBound(aR) + 1

            Else

                Zwischenstand = "0-" & n

            End If

            Exit Function

        

        End If

    Else

        Dim asA() As String, asB() As String

        Dim sSep As String, sTemp As String

        Dim i As Long, j As Long, uA As Long, uB As Long, uR As Long

        asA = Split(strA, " ")

        asB = Split(strB, " ")

        sSep = Application.DecimalSeparator

        uA = UBound(asA)

        uB = UBound(asB)

        uR = uA + uB + 1

        ReDim aR(uR)

        

        If n >= uR + 1 Then

            Zwischenstand = uA + 1 & "-" & uB + 1

            Exit Function

        End If

        

        For i = 0 To uA

            aR(i) = Format(Val(Replace(asA(i), sSep, ".")), "0.00A")

        Next

        For i = 0 To uB

            aR(i + uA + 1) = Format(Val(Replace(asB(i), sSep, ".")), "0.00B")

        Next

        For i = 0 To uR - 1

            For j = i + 1 To uR

                If Val(aR(i)) > Val(aR(j)) Then

                    sTemp = aR(j)

                    aR(j) = aR(i)

                    aR(i) = sTemp

                End If

            Next j

        Next i

        Dim ToreA As Long, ToreB As Long

        ToreA = 0

        ToreB = 0

        For i = 0 To n - 1 ' Nur die ersten n Treffer berücksichtigen

            If Right(aR(i), 1) = "A" Then

                ToreA = ToreA + 1

            ElseIf Right(aR(i), 1) = "B" Then

                ToreB = ToreB + 1

            End If

        Next i

        

        Zwischenstand = ToreA & "-" & ToreB

    

    End If



End Function

Forumthread: Funktion funktioniert falsch

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Funktion funktioniert falsch

Forumthread: Funktion funktioniert falsch

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread