Sub test()
    Dim 一覧() As String

    '処理の都合で最初の一人だけ名前をセットしておく '
    ReDim Preserve 一覧(10, 0)
    一覧(0, 0) = Range("B2")

    For r = 2 To Cells(Rows.Count, 2).End(xlUp).Row  '2行目から最後まで調べる '
        名前 = Cells(r, "B")  'B列から名前を取り出す '

        '名前が一覧の配列の中にあるか調べる '
        n = -1
        For i = 0 To UBound(一覧, 2)
            If 一覧(0, i) = 名前 Then n = i
        Next i

        'なかったらその人の行を追加 '
        If n = -1 Then
            n = UBound(一覧, 2) + 1
            ReDim Preserve 一覧(10, n)
            一覧(0, n) = 名前
        End If

        'D列とF列の数字の範囲に札を持っているフラグをセット '
        For i = Cells(r, "D") To Cells(r, "F")
            一覧(i, n) = 1
        Next i
    Next r

    '結果を整理して出力 '
    For r = 0 To UBound(一覧, 2)
        '一人ずつフラグを見ながら、変数sに数字をまとめる '
        s = ""
        For i = 1 To 10
            If 一覧(i, r) <> "" Then s = s & "、" & i  'どんどん追加 '
        Next i
        s = Mid(s, 2, 30)  '先頭の読点を消す '
        Debug.Print 一覧(0, r), s
    Next r

End Sub

• Like
• LINE
• Tweet
• Copy URL