Wie kann man in einer Tabelle mit Gruppen und Mitgliedern einen bestimmten Prozentsatz der Mitglieder pro Gruppe reduzieren?

Question

Ich habe eine Excel-Tabelle mit einer Tabelle von Gruppen und Mitgliedern. Beispiel:

A Jonathan
A Roger
A Donald
B John
B Lilya
C Richard
C Lorry

Ich möchte die Anzahl der Mitglieder pro Gruppe um sagen wir 60 % reduzieren. Dabei ist es egal, welche Mitglieder weggelassen werden. Gruppe B enthält beispielsweise 2 Mitglieder, also möchte ich 1 Mitglied entfernen (2*0,6=1,2, also sollte es nach unten abgerundet werden; ich möchte, dass es aufgerundet wird, wenn es mehr als 0,5 ist).

Ist das mit Excel-Formeln möglich?

Answer 1

Eine Pivot-Tabelle wie von @EngineerToast gezeigt ist eine viel einfachere Möglichkeit, dies zu tun. Aber ich liebe eine gute, lächerlich überentwickelte Lösung, also hier eine Möglichkeit, dies in VBA zu tun. Ich habe den Verdacht, dass ich es mit dem Wörterbuch zu kompliziert gemacht habe. Wahrscheinlich hätte ich es auch einfach mit einer anderen Schnellzählung und dem anschließenden Hinzufügen des bereits verwendeten Buchstabens zu einem Array tun können, aber so ist es nun einmal...!

Public Sub ReduceMembers()
    Dim GroupColumn: GroupColumn = 1                        'Original column containing your Groups
    Dim MemberColumn: MemberColumn = 2                      'Original column containing your Members
    Dim ReductionAmount: ReductionAmount = 0.6              'Percentage as a decimal fraction
    Range("D1").Select                                      'Start cell for your new columns

    Dim LastRow: LastRow = GetLastRow(GroupColumn)
    Dim Dictionary, DictionaryKey, I
    Set Dictionary = CreateObject("Scripting.Dictionary")

    For I = 1 To LastRow
        Dim Value: Value = Cells(I, GroupColumn).Value
        If Dictionary.Exists(Value) Then
            Dictionary(Value) = Dictionary(Value) + 1
        Else
            Dictionary.Add Value, 1
        End If
    Next

    For Each DictionaryKey In Dictionary.Keys
        Dim MaxAmount: MaxAmount = Math.Round(Dictionary(DictionaryKey) * ReductionAmount, 0)
        Dim CurrentAmount: CurrentAmount = 0
        For I = 1 To LastRow
            If Cells(I, GroupColumn) = DictionaryKey Then
                If CurrentAmount >= MaxAmount Then
                    Exit For
                End If
                ActiveCell.Value = DictionaryKey
                ActiveCell.Offset(0, 1).Value = Cells(I, MemberColumn).Value
                ActiveCell.Offset(1, 0).Select

                CurrentAmount = CurrentAmount + 1
            End If
        Next
    Next

End Sub

Function GetLastRow(GroupColumn)
    Dim Count
    Count = 0
    Do
        Count = Count + 1
    Loop Until IsEmpty(Cells(Count, GroupColumn).Value)
    GetLastRow = Count - 1
End Function

Answer 2

Für eine einmalige Aktion können Sie dies mit einer Pivot-Tabelle tun. Wenn Sie dies häufig tun müssen, kann dieser Ansatz umständlich werden.

Fügen Sie zunächst Spaltenüberschriften hinzu. Ich habe Groupund verwendet Name. Wählen Sie eine beliebige Zelle in der Liste aus und klicken Sie im Menüband „Einfügen“ (ganz linke Schaltfläche) auf „PivotTable“.

Essollenautomatisch den Bereich erraten, auf den die Pivot-Tabelle angewendet werden soll. Sie sollten einfach auf „OK“ klicken können, um Ihre Pivot-Tabelle einem neuen Blatt hinzuzufügen. Fügen Sie als Nächstes die Felder hinzu Groupund dann Namezum Zeilenabschnitt der Tabelle, indem Sie sie aus der Feldliste in die Zeilenliste ziehen. Sie müssen auch ziehenetwasin den Bereich „Werte“, sonst können Sie nicht nach dem obersten Prozentsatz filtern.

Klicken Sie mit der rechten Maustaste auf einen der Namen in der Pivot-Tabelle und klicken Sie dann auf „Filter“ > „Top 10 …“.

Richten Sie den Filter nach Wunsch ein und klicken Sie auf „OK“.

Damit es Ihren Originaldaten ähnlicher wird, klicken Sie mit der rechten Maustaste auf die Tabelle, gehen Sie zu „PivotTable-Optionen“, dann zur Registerkarte „Anzeige“ und aktivieren Sie „Klassisches PivotTable-Layout“. Klicken Sie anschließend mit der rechten Maustaste auf eine der Gruppen in der PivotTable und klicken Sie auf „Feldeinstellungen“. Setzen Sie „Zwischensummen“ auf „Keine“ und aktivieren Sie auf der Registerkarte „Layout und Drucken“ die Option „Elementbeschriftungen wiederholen“.