グループとメンバーのテーブルで、グループごとにメンバーの特定の割合を減らすにはどうすればよいでしょうか?

Question 1

@EngineerToast が示したようなピボットテーブルは、これを行うためのはるかに簡単な方法です。しかし、私はとんでもなく過剰に設計された優れたソリューションが大好きなので、VBA でそれを実行する 1 つの方法を次に示します。辞書を使用して複雑にしすぎたのではないかと思います。おそらく、他の簡単なカウントを使用して、すでに使用されている文字を配列に追加するだけでも実行できたでしょうが、これが現状です。

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

@EngineerToast が示したようなピボットテーブルは、これを行うためのはるかに簡単な方法です。しかし、私はとんでもなく過剰に設計された優れたソリューションが大好きなので、VBA でそれを実行する 1 つの方法を次に示します。辞書を使用して複雑にしすぎたのではないかと思います。おそらく、他の簡単なカウントを使用して、すでに使用されている文字を配列に追加するだけでも実行できたでしょうが、これが現状です。

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

Question 2

1 回限りのアクションの場合は、ピボットテーブルを使用してこれを行うことができます。頻繁に実行する必要がある場合、この方法は扱いにくくなる可能性があります。

まず、列見出しを追加します。私はGroupとを使用しましたName。リスト内の任意のセルを選択し、[挿入] リボン (左端のボタン) の [ピボットテーブル] をクリックします。

それすべきピボットテーブルを適用する範囲を自動的に推測します。「OK」をクリックするだけで、ピボットテーブルが新しいシートに追加されます。次に、フィールドを追加しGroup、Nameフィールドリストから行リストにドラッグしてテーブルの行部分に追加します。何か値の部分に追加しないと、上位パーセントをフィルタリングできません。

ピボットテーブル内の名前の 1 つを右クリックし、[フィルター] > [上位 10 件...] をクリックします。

フィルターを必要に応じて設定し、「OK」をクリックします。

元のデータに似た外観にするには、テーブルを右クリックし、[ピボットテーブルオプション] に移動して [表示] タブで [クラシックピボットテーブルレイアウト] をオンにします。次に、ピボットテーブル内のグループの 1 つを右クリックし、[フィールド設定] をクリックします。[小計] を [なし] に設定し、[レイアウトと印刷] タブで [アイテムラベルの繰り返し] をオンにします。

Answer