Thema Datum  Von Nutzer Rating
Antwort
09.02.2024 13:15:03 Hady
Solved
Blau Gefilterte Daten mit Duplikate
23.04.2024 09:33:28 Ben
NotSolved
23.04.2024 22:44:12 Nobody
NotSolved
26.04.2024 20:34:32 Ben
NotSolved
24.04.2024 04:55:29 Ocetea Support
NotSolved
27.04.2024 14:07:05 RPP63
NotSolved

Ansicht des Beitrags:
Von:
Ben
Datum:
23.04.2024 09:33:28
Views:
37
Rating: Antwort:
  Ja
Thema:
Gefilterte Daten mit Duplikate

Hallo,

folgende Lösung liefert diese Ergebnisse:

19122-S307 Groß
19023-S315 Klein
19122-S307 Groß
12356-S353 In
19122-S307 Groß
10565-S369 Klein
   
Groß 1
Klein 2
In 1

Folgende Funktion kommt hier zum Einsatz:

=AnzahlAufträge($A$1:$B$6; A8)

A1:B6 verweist auf die Daten; A8 verweist auf "Groß"

Die VBA-Funktion ist so aufgebaut:

Option Explicit

Function AnzahlAufträge(Daten As Range, Art As String)
    Dim cnt As Integer
    Dim iRow As Integer
    Dim arData As Variant
    Dim tmpAuftrag As String
    arData = Daten.Value
    QuickSortArray SortArray:=arData, lngColumn:=2
    For iRow = LBound(arData, 1) To UBound(arData, 1)
        'Debug.Print arData(iRow, 1), arData(iRow, 2)
        If arData(iRow, 2) = Art Then
            If Not arData(iRow, 1) = tmpAuftrag Then
                cnt = cnt + 1
                tmpAuftrag = arData(iRow, 1)
            End If
        End If
    Next
    AnzahlAufträge = cnt
End Function

Public Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, Optional lngColumn As Long = 0)
    On Error Resume Next

    ' Quelle: https://stackoverflow.com/questions/4873182/sorting-a-multidimensionnal-array-in-vba

    'Sort a 2-Dimensional array

    ' SampleUsage: sort arrData by the contents of column 3
    '
    '   QuickSortArray arrData, , , 3

    '
    'Posted by Jim Rech 10/20/98 Excel.Programming

    'Modifications, Nigel Heffernan:

    '       ' Escape failed comparison with empty variant
    '       ' Defensive coding: check inputs

    Dim i As Long
    Dim j As Long
    Dim varMid As Variant
    Dim arrRowTemp As Variant
    Dim lngColTemp As Long

    If IsEmpty(SortArray) Then
        Exit Sub
    End If
    If InStr(TypeName(SortArray), "()") < 1 Then  'IsArray() is somewhat broken: Look for brackets in the type name
        Exit Sub
    End If
    If lngMin = -1 Then
        lngMin = LBound(SortArray, 1)
    End If
    If lngMax = -1 Then
        lngMax = UBound(SortArray, 1)
    End If
    If lngMin >= lngMax Then    ' no sorting required
        Exit Sub
    End If

    i = lngMin
    j = lngMax

    varMid = Empty
    varMid = SortArray((lngMin + lngMax) \ 2, lngColumn)

    ' We  send 'Empty' and invalid data items to the end of the list:
    If IsObject(varMid) Then  ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property
        i = lngMax
        j = lngMin
    ElseIf IsEmpty(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf IsNull(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf varMid = "" Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) = vbError Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) > 17 Then
        i = lngMax
        j = lngMin
    End If

    While i <= j
        While SortArray(i, lngColumn) < varMid And i < lngMax
            i = i + 1
        Wend
        While varMid < SortArray(j, lngColumn) And j > lngMin
            j = j - 1
        Wend

        If i <= j Then
            ' Swap the rows
            ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2))
            For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2)
                arrRowTemp(lngColTemp) = SortArray(i, lngColTemp)
                SortArray(i, lngColTemp) = SortArray(j, lngColTemp)
                SortArray(j, lngColTemp) = arrRowTemp(lngColTemp)
            Next lngColTemp
            Erase arrRowTemp

            i = i + 1
            j = j - 1
        End If
    Wend

    If (lngMin < j) Then Call QuickSortArray(SortArray, lngMin, j, lngColumn)
    If (i < lngMax) Then Call QuickSortArray(SortArray, i, lngMax, lngColumn)
    
End Sub

Die Sub "QuickSortArray" stammt aus einer anderen Quelle.

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
09.02.2024 13:15:03 Hady
Solved
Blau Gefilterte Daten mit Duplikate
23.04.2024 09:33:28 Ben
NotSolved
23.04.2024 22:44:12 Nobody
NotSolved
26.04.2024 20:34:32 Ben
NotSolved
24.04.2024 04:55:29 Ocetea Support
NotSolved
27.04.2024 14:07:05 RPP63
NotSolved