追加されていく名簿を、部ごとに分類し別シートに表示するマクロの実装について

Question

前提・実現したいこと

excelで追加されていく名簿を別シートで部ごとに分類して表示したいです。

【sheet1】
営業部,山田
経理部,田中
営業部,鈴木
↓イベント発生(ボタンクリック等)
【sheet2】
営業部,経理部,財務部
山田,田中
鈴木

sheet1に人を追加する度、sheet2で列ごと(部ごと)に分類して表示したいです。
部の名前や数は既に決まっていることを前提としています。

試したこと・発生している問題・エラーメッセージ

2次元配列の各行の各部署のメンバー名を格納できたのですが、
新たな人員を追加する際いれる配列の場所を決める作業が
無駄が多いように感じています。

各行それぞれ別で列の数を決めるようなジャグ配列などを使うことで、
無駄を省くことができれば嬉しく思っております。
方法にこだわりはございませんので、効率の良い方法について
なにかアドバイスいただけましたら幸いです。

Sub click()

'部のリスト
    Dim n_category As Integer
    n_category = 3
    Dim list_category()
    ReDim list_category(n_category, 2)
    list_category(0, 0) = "営業部"
    list_category(1, 0) = "経理部"
    list_category(2, 0) = "財務部"
    Dim i
    For i = 0 To n_category
        list_category(i, 1) = 0
        Next
    
    '名前分類の配列(list_category(0)営業部の人を0行に格納)
    Dim strArray()
    '3行1列の配列を用意
    ReDim Preserve strArray(n_category, 0)
    For i = 0 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'sheet1 rows
        Dim j 'type of category
        For j = 0 To n_category - 1
            If (Cells(i + 1, 1) = list_category(j, 0)) Then
                list_category(j, 1) = list_category(j, 1) + 1
                Dim size, k
                size = 0
                For k = 0 To n_category - 1
                    If (list_category(k, 1) > size) Then
                        size = list_category(k, 1) 'decide Column size
                        Cells(i + 1, 3) = size
                        End If
                    Next
                ReDim Preserve strArray(n_category, size)
                strArray(j, list_category(j, 1) - 1) = Cells(i + 1, 2)
                
            Exit For
            End If
            Next
        Next
    
    For i = 0 To n_category - 1
        Worksheets("Sheet2").Cells(1, i + 1) = list_category(i, 0)
        Next
        
    For i = 0 To n_category - 1
        For j = 0 To size - 1
            Worksheets("Sheet2").Cells(j + 2, i + 1) = strArray(i, j)
            Next
        Next
End Sub

名簿の部署名によって分類していく際に、
入れるべき配列の場所(任意の部署行の最終列の次)を特定するのが楽なのかと思い
コメントにてお教えいただいたジャグ配列が適当なのかと考えておりました。

具体的には既に配列が以下のような時、
営業部(0行目) 山田,鈴木
経理部(1行目) 田中
財務部(2行目)
「経理部 佐藤」を追加する際、配列の箇所指定はどのようにするのが好ましいでしょうか。

ちなみにこの度はsheet2に部署ごとの並びとして貼り付け、
事前にその範囲を名前の定義しておいたリストを別の場所でドロップダウンリストとして用いる予定です。

Comments

[meg_]

コードを掲載しましょう。

[20200713]

コメントありがとうございます。コード掲載いたしました。

[vann_2921]

確認なんですが、どうして各部署について長さの異なる配列を保持するようにしたいのでしょうか？
長さの異なる配列の配列はジャグ配列と言って人が扱うには直感的に分かりやすく余分な要素を持たないのでメモリも節約できますがエクセルVBAでは2次元配列特有のメリットがあります。
2次元配列を val(1 To 3, 1 To 2) のように1から始まるインデックスで確保することでRange("A1:B3").Value = val とすることで一回ですべてのセルに代入できます。
質問文からはSheet1からSheet2へ転記する処理と思いますのでジャグ配列より2次元配列のままの方がメリットがありそうな気がします。
もう少し、2次元配列でどんなことに困っているのか説明してもらえるとより良い回答ができるかと思います。

[20200713]

コメントありがとうございます。現状について追記いたしました！

Answer 1

DictionaryとArrayListを使った例です。
Dictionaryのキーに部署名をセットします。キーに対応する値はArralistになります。
Dictionaryについては
https://tonari-it.com/excel-vba-dictionary-object/
https://www.sejuku.net/blog/29736
ArrayListについては
https://www.yuu-progra.com/2019/11/30/vba-arraylist/
https://vbabeginner.net/use-net-framework-arraylist/
あたりを参考にしてください。

部署数は予め決まっている必要はありません。
各部署の氏名も同様です。

Public Sub 部署毎に並び替え()
    Dim wrow As Long
    Dim wcol As Long
    Dim maxrow As Long
    Dim dicT As Object          'Dictionary
    Dim ArrList As Object       'ArrayList
    Dim key As Variant
    Dim name As String
    Dim i As Long
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("Sheet2")
    maxrow = sh1.Cells(rows.Count, 1).End(xlUp).row 'sheet1 最終行を求める
    Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    'Sheet1を１から最終行まで処理
    For wrow = 1 To maxrow
        key = sh1.Cells(wrow, "A").value    '部署名
        If dicT.exists(key) = False Then
            '部署名未登録時、部署をDictionaryに登録
            Set ArrList = CreateObject("System.Collections.ArrayList")     '.NET Frameworkへの参照
            dicT.Add key, ArrList
        End If
        name = sh1.Cells(wrow, "B").value   '氏名
        dicT(key).Add name                  '氏名を当該部署に追加
    Next
    sh2.Cells.Clear
    wcol = 1
    'Dictionaryの全てのキー（部署）を処理
    For Each key In dicT
        sh2.Cells(1, wcol).value = key
        'ArrayList中の氏名を全て出力
        For i = 0 To dicT(key).Count - 1
            sh2.Cells(2 + i, wcol).value = dicT(key)(i)
        Next
        wcol = wcol + 1
    Next
    MsgBox ("完了")
End Sub

実行結果

Comments

[20200713]

ご回答いただきありがとうございます。
こちら理想的に思い自分の環境でも実装してみたのですが、
以下のエラーが出てしまいました。
記載いただいたものそのままなのでエラーの理由が不明なのですが、
何かご意見いただけましたら助かります…！

実行時エラー'429':
ActiveX コンポーネントはオブジェクトを作成できません。

コード該当箇所
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義

[tatsu99]

もしかして、環境はmacでしょうか。macではDictionaryはサポートしていません。
windowsでないと使用できません。

[20200713]

そうなのですね…！当方、環境はmacです…
Dictionary便利そうなので大変残念ですが、利用を断念いたします…！

Answer 2

list_category(0, 0) = "営業部"
list_category(1, 0) = "経理部"
list_category(2, 0) = "財務部"
部署が追加になった場合、コード書き換えするのですか？
私の場合、これしか思い浮かびませんでした。
サンプルコード記載します

Sub Test()
Dim 部署 As String
Dim 担当 As String
Dim i As Long
Dim Ro As Long '最終行
Dim Col As Long '最終列

    Sheets("入力").Select
    部署 = Cells(2, 3).Value
    担当 = Cells(3, 3).Value
    Sheets("社員MS").Select
     Col = Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 1 To Col
        Ro = Cells(Rows.Count, i).End(xlUp).Row + 1
        If 部署 = Cells(1, i) Then
            Cells(Ro, i) = 担当
            Exit For
        End If
   Next i
   Sheets("入力").Select
End Sub

Answer 3

sheet1に項目名（A1に「部署名」、B1に「氏名」）を入れておき
オートフィルターを使えばいいと思います。
部署ごとの氏名が必要ならこの後sheet2からとれます。

Sub click()

    '部のリスト
    Dim n_category As Integer
    n_category = 3
    Dim list_category() As String
    ReDim list_category(n_category)
    list_category(1) = "営業部"
    list_category(2) = "経理部"
    list_category(3) = "財務部"

    Dim ws1 As Worksheet: Set ws1 = Worksheets("sheet1")
    Dim ws2 As Worksheet: Set ws2 = Worksheets("sheet2")
    
    ws2.Cells.Clear
    
    Dim i As Long
    For i = 1 To UBound(list_category)
        With ws1
            .Range("a1").CurrentRegion.AutoFilter field:=1, Criteria1:=list_category(i)
            Dim rng As Range
            Set rng = .Cells(Rows.Count, 2).End(xlUp)
            If rng.Row <> 1 Then
                .Range(.Range("b2"), rng).SpecialCells(xlCellTypeVisible).Copy
            End If
        End With
        With ws2
            .Cells(1, i) = list_category(i)
            If rng.Row <> 1 Then
                .Cells(Rows.Count, i).End(xlUp).Offset(1).PasteSpecial
            End If
        End With
    Next i
    
    ws1.AutoFilterMode = False
End Sub

Answer 4

要素ごとに長さの異なる配列(ジャグ配列)を作成するときはVariant型の配列を用意し、その要素ごとに別の配列を用意します。

Dim v(2) as Variant 'Variant型の配列
Dim elm1(3) as Variant '要素1
Dim elm2(1) as Variant '要素2
Dim elm3(2) as Variant '要素3
v(0) = elem1
v(1) = elem2
v(2) = elem3
v(0)(1) ' 1番目の要素の2個目にアクセス v(0, 1)ではない。

みたいな感じです。

Comments

[20200713]

この度は探していたようなジャグ配列についてお教えいただいたこちらをベストアンサーとさせていただきます。最終的には二次元配列で実装いたしましたが、ご相談きいていただきありがとうございました。

他の方々も知らなかった方法をお教えいただき大変勉強になりました。必要な局面でつけるよう勉強いたします！