Hallo Case, hallo Marc,

ich habe im Laufe des Tages versucht, Case' Erklärung zu verstehen und das mit dem Floating Point habe ich zum ersten mal gehört. Also wenn ich euch richtig verstehe sieht der Wert wie 0,1 oder eben 10% aus, aber intern wird er als ein minimal größerer oder kleinerer wert gespeichert. Es kann also sein dass der Code auf <0,1 prüft aber in der Zelle ein Wert steh der etwas größer als 0,1 ist und das geht schief. Deshalb schlägt Case vor, auf Round(valF, 10) also 10 Nachkommastellen zu runden. Marc schlägt vor, mit 100 zu multiplizieren valF = valF * 100 und zu prüfen If valF <= 10 And valF > 0 Then.

Ich hoffe, ich habe es verstanden.
Aber ich habe mir gedacht, trotzdem wo kommen diese Unstimmigkeiten her.

Die Prozentrechnung ist eigentlich simpel, Rang(E1)/Anzahl(E:E) ergibt mit 2 Nachkommastellen aufgerundet den Prozentwert. (Hierbei bedenken, dass ich nur 10% des Blatts Codes geschickt habe wegend der Größenbeschränkung, wenn alle Daten da wären, würde die Rechnung passen).

Habe mir dann die Rechnung in der Originaldatei angeschaut. =RANG(E37346;E1:E45000;0) ergibt 3279, =ANZAHL(E:E) ergibt 32786, somit der Quotient 0,1000122 was >0,1 ist und damit auf 2 Stellen aufgerundet eigentlich 11% sein müsste.

Und damit meine Vermutung, dass 0,1000122 der intern gespeicherte, als 10% angezeigte Wert ist, der nicht ins Blatt AZN übernommen wurde weil >0,1.

Aber dann zu meiner Frage, das hier ist das Makro, dass die Prozentzahlen in der Originaldatei berechnet hat, warum hat es 0,1000122 zu 10% abgerundet?

Public Sub BerechneCodesRanking(ws As Worksheet)

    Dim Eingabearray As Variant

    Dim DatumArray() As Double

    Dim Ausgabearray() As Variant

    Dim RangDict As Object

    Dim GesamtZeilen As Long

    Dim i As Long, j As Long

    Dim AnzahlGueltigerDaten As Long

    Dim LetztesDatum As Double



    ' Daten aus Spalte E einlesen

    GesamtZeilen = ws.Cells(ws.Rows.count, "E").End(xlUp).row

    Eingabearray = ws.Range("E1:E" & GesamtZeilen).Value



    ' Nur gültige Datumswerte zählen

    AnzahlGueltigerDaten = 0

    For i = 1 To GesamtZeilen

        If IsDate(Eingabearray(i, 1)) Or Trim(Eingabearray(i, 1)) <> "" Then

            AnzahlGueltigerDaten = AnzahlGueltigerDaten + 1

        End If

    Next i



    If AnzahlGueltigerDaten = 0 Then Exit Sub



    ' DatumArray dimensionieren

    ReDim DatumArray(1 To AnzahlGueltigerDaten)

    j = 1

    For i = 1 To GesamtZeilen

        If IsDate(Eingabearray(i, 1)) Or Trim(Eingabearray(i, 1)) <> "" Then

            DatumArray(j) = DatumZuSortierwert(Eingabearray(i, 1))

            j = j + 1

        End If

    Next i



    ' Absteigend sortieren

    QuickSortDatum DatumArray, 1, AnzahlGueltigerDaten



    ' RangDictionary erstellen

    Set RangDict = CreateObject("Scripting.Dictionary")

    For i = 1 To AnzahlGueltigerDaten

        If i = 1 Or DatumArray(i) <> LetztesDatum Then

            RangDict(CStr(DatumArray(i))) = i

        End If

        LetztesDatum = DatumArray(i)

    Next i



    ' Ausgabe vorbereiten

    ReDim Ausgabearray(1 To GesamtZeilen, 1 To 1)

    For i = 1 To GesamtZeilen

        If IsDate(Eingabearray(i, 1)) Or Trim(Eingabearray(i, 1)) <> "" Then

            Ausgabearray(i, 1) = WorksheetFunction.RoundUp( _

                RangDict(CStr(DatumZuSortierwert(Eingabearray(i, 1)))) / AnzahlGueltigerDaten, 2)

        End If

    Next i



    ' Ergebnisse in Spalte F schreiben

    ws.Range("F1").Resize(GesamtZeilen, 1).Value = Ausgabearray

    ws.Range("F1").Resize(GesamtZeilen, 1).NumberFormat = "0%"

End Sub





Private Function DatumZuSortierwert(ByVal v As Variant) As Double

    Dim Teile() As String

    Dim Tag As Long, Monat As Long, jahr As Long



    ' Wenn Excel es als Datum erkennt

    If IsDate(v) Then

        jahr = Year(v)

        Monat = Month(v)

        Tag = Day(v)

        DatumZuSortierwert = jahr * 10000# + Monat * 100# + Tag

        Exit Function

    End If



    ' Wenn Text "dd.mm.yyyy"

    If InStr(v, ".") > 0 Then

        Teile = Split(v, ".")

        If UBound(Teile) = 2 Then

            Tag = val(Teile(0))

            Monat = val(Teile(1))

            jahr = val(Teile(2))

            DatumZuSortierwert = jahr * 10000# + Monat * 100# + Tag

            Exit Function

        End If

    End If



    ' Sonst 0 zurückgeben

    DatumZuSortierwert = 0

End Function



Private Sub QuickSortDatum(ByRef arr() As Double, ByVal IndexUnten As Long, ByVal IndexOben As Long)

    Dim PivotWert As Double

    Dim TempWert As Double

    Dim Links As Long

    Dim Rechts As Long



    Links = IndexUnten

    Rechts = IndexOben

    PivotWert = arr((IndexUnten + IndexOben) \ 2)



    Do While Links <= Rechts

        Do While arr(Links) > PivotWert

            Links = Links + 1

        Loop

        Do While arr(Rechts) < PivotWert

            Rechts = Rechts - 1

        Loop

        If Links <= Rechts Then

            TempWert = arr(Links)

            arr(Links) = arr(Rechts)

            arr(Rechts) = TempWert

            Links = Links + 1

            Rechts = Rechts - 1

        End If

    Loop



    If IndexUnten < Rechts Then QuickSortDatum arr, IndexUnten, Rechts

    If Links < IndexOben Then QuickSortDatum arr, Links, IndexOben

End Sub