ActiveSheet.ChartObjects("グラフ 1").Activate
    ActiveSheet.ChartObjects("グラフ 1").Activate
    With ActiveChart.ChartTitle
        
       .Left = 36.86
        .Top = 18
       .Text = "BBBaaaaaaaaaaaaaaaaaaaaaaaa00000000かなかなかな"


MsgBox .HorizontalAlignment

'        .Strike = msoNoStrike
    .HorizontalAlignment = xlHAlignCenter ''折り返したら真ん中
    .HorizontalAlignment = xlHAlignCenterAcrossSelection ''↑と同じ
    .HorizontalAlignment = xlHAlignDistributed 'XXX割付 折り返しも割付変
    .HorizontalAlignment = xlHAlignFill ''同上
    .HorizontalAlignment = xlHAlignGeneral '''きゅっとして、折り返しは左寄せ
    .HorizontalAlignment = xlHAlignJustify ''きゅ ↑と同じ
    .HorizontalAlignment = xlHAlignLeft ''きゅ ↑と同じ
    .HorizontalAlignment = xlHAlignFill 'xxx割付折り返したら変
    .HorizontalAlignment = xlHAlignRight '右寄せ 折り返しも右寄せ
    End With

End Sub
*************************************************************

Sub PUB専攻初期化()

    '初期化
    PUB_ary専攻.学部番号 = ""
    PUB_ary専攻.学部CODE = ""
    PUB_ary専攻.学部名 = ""
    PUB_ary専攻.学科番号 = ""
    PUB_ary専攻.学科CODE = ""
    PUB_ary専攻.学科名 = ""
    PUB_ary専攻.専攻番号 = ""
    PUB_ary専攻.専攻CODE = ""
    PUB_ary専攻.専攻名 = ""
    PUB_ary専攻.質問CODE = ""


End Sub



'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Private Sub cmdGO_Click()

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

:

        '---------------------------
        '学科についてLOOP
        For K = 0 To UBound(ary学科)
            target学科 = ary学科(K)
        '---------------------------
            '指定の学部番号内学科を調べる
            MODE = 2
            Call SET_aryOUT(MODE, target学部, target学科, 0, 質問重複)
            
            If flg学科 = 1 And PUB_ary専攻.学部番号 <> "" Then  '作成するなら


:


            '---------------------------
            '専攻についてLOOP
            For S = 0 To UBound(ary専攻)
                target専攻 = ary専攻(S)
            '---------------------------
''                '指定の学科番号を調べる
                MODE = 3
                Call SET_aryOUT(MODE, target学部, target学科, target専攻, 質問重複)
                
                If flg専攻 = 1 And PUB_ary専攻.学部番号 <> "" Then '作成するなら





'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Function SET_aryOUT(MODE, tmp学部番号, tmp学科番号, tmp専攻番号, 質問重複)
    
'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
    
    Dim flgEND As Boolean: flgEND = False
   
   
    If MODE < 1 Or MODE > 3 Then
        MsgBox "SET_aryOUT : MODE不正(1~3)--" & CStr(MODE)
        Exit Function
    End If
        
   'PUB_ary学部等検索に値がセットされていないので、まず作成
   If (Not PUB_ary学部等一覧) = -1 Then
        ret = 学部等配列作成()
    End If

    Module1.PUB専攻初期化
										
										
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
										
	学部	学部CODE	学部名	学科番号	学科CODE	学科名	専攻番号	専攻CODE	専攻名	質問CODE
	1	UAA	A学部	1 	10	aa学科				UAA10
				2 	20	あああ学科	1	01	あああ1専攻	UAA20
					20	あああ学科	2	02	あああ2専攻	UAA20
	2	UBB	B学部	3 	0	bb学科	1	B01	bb1コース	UBB
		UBB	B学部		0	bb学科	2	B02	bb2コース	UBB
	3	UCC	C学部							UCC20
		UCC		1 	30	喫茶学科	1	UCCB	喫茶経営コース	UCC30
		UCC			30	喫茶学科	2	UCCD	喫茶入れ方コース	UCC30
		UCC			30	喫茶学科	3	20	喫茶焙煎コース	UCC30
		UCC		2 	50	喫茶歴史学科				UCC30
		UCC			50	喫茶歴史学科	1	KISSA	研究コース	UCC30
	4	UCE	E学部	1 	60	学部六十				UCE
		UCE	E学部	2 	70	学科七十				UCE


■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

ON MODULE

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Public Type type学部
    学部番号 As Variant
    学部CODE As Variant
    学部名 As Variant
    質問CODE As Variant
    
End Type




Public Type type学科
    学部番号 As Variant
    学部CODE As Variant
    学部名 As Variant
    学科番号 As Variant
    学科CODE As Variant
    学科名 As Variant
    質問CODE As Variant
End Type

Public Type type専攻
    学部番号 As Variant
    学部CODE As Variant
    学部名 As Variant
    学科番号 As Variant
    学科CODE As Variant
    学科名 As Variant
    専攻番号 As Variant
    専攻CODE As Variant
    専攻名 As Variant
    質問CODE As Variant
End Type


Public Type typeコンボ
    番号 As Variant
    CODE As Variant
    名称 As Variant
End Type

'Public Pub_ary学部() As type学部
'Public PUB_ary学科() As type学科
Public PUB_ary専攻 As type専攻
Public PUB_aryコンボ() As typeコンボ

Public PUB_ary学部等検索() As type専攻 '--3次元配列 学部学科専攻の番号で一意に引ける
Public PUB_ary学部等一覧() As type専攻  '--一次元配列


■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

ON SHEET

■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■



'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Private Sub cmdGO_Click()

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓


'選んだ学部学科の一覧作成

Dim sheetOUT As Worksheet
Dim aryOUT() As type専攻
Dim cnt, rOUT
Dim ary学部(), ary学科(), ary専攻()
Dim target学部, target学科, target専攻

Set sheetOUT = ActiveWorkbook.Sheets("作業")

flg学部 = 0: flg学科 = 0: flg専攻 = 0
If Me.CheckBox1 Then
    flg学部 = 1
End If
If Me.CheckBox2 Then
    flg学科 = 1
End If

If Me.CheckBox3 Then
    flg専攻 = 1
End If

If flg学部 + flg学科 + flg専攻 = 0 Then
    MsgBox "作るチェックが無いので作成しません。中断します。"
    Exit Sub
End If

my学部番号 = Range("学部番号控")
my学科番号 = Range("学科番号控")
my専攻番号 = Range("専攻番号控")

my学部名 = Range("学部名控")
my学科名 = Range("学科名控")
my専攻名 = Range("専攻名控")

my学部〇 = IIf(flg学部 = 0, "--(出力しない)", "")
my学科〇 = IIf(flg学科 = 0, "--(出力しない)", "")
my専攻〇 = IIf(flg専攻 = 0, "--(出力しない)", "")

If MsgBox("〇学部:" & my学部名 & my学部〇 & vbCrLf & _
          "〇学科:" & my学科名 & my学科〇 & vbCrLf & _
          "〇専攻:" & my専攻名 & my専攻〇 & vbCrLf & _
          "以上の設定で成果品を出力しますか?", vbOKCancel) = vbCancel Then
    MsgBox "中断します"
    Exit Sub
End If


sheetOUT.Range(sheetOUT.Rows(6), sheetOUT.Rows(50)).Clear

cnt = 0

c対象 = sheetOUT.Range("対象").Column
c作成有無 = sheetOUT.Range("作成有無").Column
c学部番号 = sheetOUT.Range("学部番号").Column
c学部CODE = sheetOUT.Range("学部CODE").Column
c学部名 = sheetOUT.Range("学部名").Column
c学科番号 = sheetOUT.Range("学科番号").Column
c学科CODE = sheetOUT.Range("学科コード").Column
c学科名 = sheetOUT.Range("学科名").Column
c専攻番号 = sheetOUT.Range("専攻番号").Column
c専攻CODE = sheetOUT.Range("専攻CODE").Column
c専攻名 = sheetOUT.Range("専攻名").Column
c質問CODE = sheetOUT.Range("質問CODE").Column
c質問重複 = sheetOUT.Range("質問重複").Column
cタイトル = sheetOUT.Range("タイトル").Column
cパス = sheetOUT.Range("パス").Column
cファイル名 = sheetOUT.Range("ファイル名").Column


'=================================

'出力

'=================================
sheetOUT.Activate
   r作業 = 5
    
    '========================
    '学部
    '========================
   If my学部番号 = 0 Then 'ALL→全学部をary学部 配列へ
        
        ' コンボ配列作成(MOD1, my学部番号, my学科番号)
        Call コンボ配列作成(1, 0, 0)
        
        For B = 0 To UBound(PUB_aryコンボ)
            ReDim Preserve ary学部(B)
            ary学部(B) = PUB_aryコンボ(B).番号
        Next B
    
    Else        '指定学部番号を ary学部 配列へ
        ReDim Preserve ary学部(0)
        ary学部(0) = my学部番号
    End If
            
'    ↑ここまで ary学部(1,2,3)とか ary学部(2)とか
    
    '---------------------------
    '学部についてLOOP
    For B = 0 To UBound(ary学部)
        target学部 = ary学部(B)
    '---------------------------
        '指定の学部番号を調べる
        MODE = 1
        Call SET_aryOUT(MODE, target学部, 0, 0, 質問重複)
        
        If flg学部 = 1 Then '作成するなら
        
            '配列に入れる
            ReDim Preserve aryOUT(cnt)
            aryOUT(cnt).学部番号 = PUB_ary専攻.学部番号
            aryOUT(cnt).学部CODE = PUB_ary専攻.学部CODE
            aryOUT(cnt).学部名 = PUB_ary専攻.学部名
            aryOUT(cnt).学科番号 = ""
            aryOUT(cnt).学科CODE = ""
            aryOUT(cnt).学科名 = ""
            aryOUT(cnt).専攻番号 = ""
            aryOUT(cnt).専攻CODE = ""
            aryOUT(cnt).専攻名 = ""
            aryOUT(cnt).質問CODE = PUB_ary専攻.質問CODE
            cnt = cnt + 1
        
            '作業シートに書く
            r作業 = r作業 + 1 '作業シートの行数
            sheetOUT.Cells(r作業, c対象) = "01_学部別"
            sheetOUT.Cells(r作業, c作成有無) = 1
            sheetOUT.Cells(r作業, c学部番号) = PUB_ary専攻.学部番号
            sheetOUT.Cells(r作業, c学部CODE) = PUB_ary専攻.学部CODE
            sheetOUT.Cells(r作業, c学部名) = PUB_ary専攻.学部名
            sheetOUT.Cells(r作業, c学科番号) = ""
            sheetOUT.Cells(r作業, c学科CODE) = ""
            sheetOUT.Cells(r作業, c学科名) = ""
            sheetOUT.Cells(r作業, c専攻番号) = ""
            sheetOUT.Cells(r作業, c専攻CODE) = ""
            sheetOUT.Cells(r作業, c専攻名) = ""
            sheetOUT.Cells(r作業, c質問CODE) = PUB_ary専攻.質問CODE
            sheetOUT.Cells(r作業, c質問重複) = 質問重複

            sheetOUT.Cells(r作業, cタイトル) = getタイトル()
            sheetOUT.Cells(r作業, cパス) = getパス()
            sheetOUT.Cells(r作業, cファイル名) = getファイル名()
        End If


    
        '========================
        '学科
        '========================
        If my学科番号 = 0 Then 'ALL→学部の全学科をary学科 配列へ
        '   コンボ配列作成(MODE, my学部番号, my学科番号)
            Call Me.コンボ配列作成(2, target学部, 0)
        
            ReDim ary学科(0)
            For K = 0 To UBound(PUB_aryコンボ)
                ReDim Preserve ary学科(K)
                ary学科(K) = PUB_aryコンボ(K).番号
            Next K
    
        Else        '指定学部番号を ary学部 配列へ
            ReDim Preserve ary学科(0)
            ary学科(0) = my学科番号
        End If
            
'        ↑ここまで ary学科(1,2,3)とか ary学科(2)とか
    
        '---------------------------
        '学科についてLOOP
        For K = 0 To UBound(ary学科)
            target学科 = ary学科(K)
        '---------------------------
            '指定の学部番号内学科を調べる
            MODE = 2
            Call SET_aryOUT(MODE, target学部, target学科, 0, 質問重複)
            
            If flg学科 = 1 Then '作成するなら
            
                '配列に入れる
                ReDim Preserve aryOUT(cnt)
                aryOUT(cnt).学部番号 = PUB_ary専攻.学部番号
                aryOUT(cnt).学部CODE = PUB_ary専攻.学部CODE
                aryOUT(cnt).学部名 = PUB_ary専攻.学部名
                aryOUT(cnt).学科番号 = PUB_ary専攻.学科番号
                aryOUT(cnt).学科CODE = PUB_ary専攻.学科CODE
                aryOUT(cnt).学科名 = PUB_ary専攻.学科名
                aryOUT(cnt).専攻番号 = ""
                aryOUT(cnt).専攻CODE = ""
                aryOUT(cnt).専攻名 = ""
                aryOUT(cnt).質問CODE = PUB_ary専攻.質問CODE
                cnt = cnt + 1
            
                '作業シートに書く
                r作業 = r作業 + 1 '作業シートの行数
                sheetOUT.Cells(r作業, c対象) = "02_学科別"
                sheetOUT.Cells(r作業, c作成有無) = 1
                sheetOUT.Cells(r作業, c学部番号) = PUB_ary専攻.学部番号
                sheetOUT.Cells(r作業, c学部CODE) = PUB_ary専攻.学部CODE
                sheetOUT.Cells(r作業, c学部名) = PUB_ary専攻.学部名
                sheetOUT.Cells(r作業, c学科番号) = PUB_ary専攻.学科番号
                sheetOUT.Cells(r作業, c学科CODE) = PUB_ary専攻.学科CODE
                sheetOUT.Cells(r作業, c学科名) = PUB_ary専攻.学科名
                sheetOUT.Cells(r作業, c専攻番号) = ""
                sheetOUT.Cells(r作業, c専攻CODE) = ""
                sheetOUT.Cells(r作業, c専攻名) = ""
                sheetOUT.Cells(r作業, c質問CODE) = PUB_ary専攻.質問CODE
                sheetOUT.Cells(r作業, c質問重複) = 質問重複
    
                sheetOUT.Cells(r作業, cタイトル) = getタイトル()
                sheetOUT.Cells(r作業, cパス) = getパス()
                sheetOUT.Cells(r作業, cファイル名) = getファイル名()
            End If

        
            '========================
            '専攻
            '========================
            If my専攻番号 = 0 Then 'ALL→学科の全専攻をary専攻 配列へ
            '   コンボ配列作成(MODE, my学部番号, my学科番号)
                Call Me.コンボ配列作成(3, target学部, target学科)
            
                ReDim ary専攻(0)
                For S = 0 To UBound(PUB_aryコンボ)
                    ReDim Preserve ary専攻(S)
                    ary専攻(S) = PUB_aryコンボ(S).番号
                Next S
        
            Else        '指定学部番号を ary学部 配列へ
                ReDim Preserve ary専攻(0)
                ary専攻(0) = my専攻番号
            End If
                
    '        ↑ここまで ary専攻(1,2,3)とか ary専攻(2)とか
        
            '---------------------------
            '専攻についてLOOP
            For S = 0 To UBound(ary専攻)
                target専攻 = ary専攻(S)
            '---------------------------
                '指定の学科番号を調べる
                MODE = 3
                Call SET_aryOUT(MODE, target学部, target学科, target専攻, 質問重複)
                
                If flg専攻 = 1 Then '作成するなら
                
                    '配列に入れる
                    ReDim Preserve aryOUT(cnt)
                    aryOUT(cnt).学部番号 = PUB_ary専攻.学部番号
                    aryOUT(cnt).学部CODE = PUB_ary専攻.学部CODE
                    aryOUT(cnt).学部名 = PUB_ary専攻.学部名
                    aryOUT(cnt).学科番号 = PUB_ary専攻.学科番号
                    aryOUT(cnt).学科CODE = PUB_ary専攻.学科CODE
                    aryOUT(cnt).学科名 = PUB_ary専攻.学科名
                    aryOUT(cnt).専攻番号 = PUB_ary専攻.専攻番号
                    aryOUT(cnt).専攻CODE = PUB_ary専攻.専攻CODE
                    aryOUT(cnt).専攻名 = PUB_ary専攻.専攻名
                    aryOUT(cnt).質問CODE = PUB_ary専攻.質問CODE
                    cnt = cnt + 1
                
                    '作業シートに書く
                    r作業 = r作業 + 1 '作業シートの行数
                    sheetOUT.Cells(r作業, c対象) = "03_専攻別"
                    sheetOUT.Cells(r作業, c作成有無) = 1
                    sheetOUT.Cells(r作業, c学部番号) = PUB_ary専攻.学部番号
                    sheetOUT.Cells(r作業, c学部CODE) = PUB_ary専攻.学部CODE
                    sheetOUT.Cells(r作業, c学部名) = PUB_ary専攻.学部名
                    sheetOUT.Cells(r作業, c学科番号) = PUB_ary専攻.学科番号
                    sheetOUT.Cells(r作業, c学科CODE) = PUB_ary専攻.学科CODE
                    sheetOUT.Cells(r作業, c学科名) = PUB_ary専攻.学科名
                    sheetOUT.Cells(r作業, c専攻番号) = PUB_ary専攻.専攻番号
                    sheetOUT.Cells(r作業, c専攻CODE) = PUB_ary専攻.専攻CODE
                    sheetOUT.Cells(r作業, c専攻名) = PUB_ary専攻.専攻名
                    sheetOUT.Cells(r作業, c質問CODE) = PUB_ary専攻.質問CODE
                    sheetOUT.Cells(r作業, c質問重複) = 質問重複
        
                    sheetOUT.Cells(r作業, cタイトル) = getタイトル()
                    sheetOUT.Cells(r作業, cパス) = getパス()
                    sheetOUT.Cells(r作業, cファイル名) = getファイル名()
                End If
    
            '---------------------------
            '専攻についてLOOP
            Next S
            '---------------------------
        
        '---------------------------
        '学科についてLOOP
        Next K
        '---------------------------

    '---------------------------
    Next B
    '学部についてLOOPここまで
    '---------------------------









End Sub

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Function getタイトル() As String

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
getタイトル = "タイトル"
End Function

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Function getパス() As String

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

getパス = "パス"
End Function

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Function getファイル名() As String

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

getファイル名 = "ファイル名"
End Function


'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Function SET_aryOUT(MODE, tmp学部番号, tmp学科番号, tmp専攻番号, 質問重複)
    
'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
    
    Dim flgEND As Boolean: flgEND = False
   
   
    If MODE < 1 Or MODE > 3 Then
        MsgBox "SET_aryOUT : MODE不正(1~3)--" & CStr(MODE)
        Exit Function
    End If
        
   'PUB_ary学部等検索に値がセットされていないので、まず作成
   If (Not PUB_ary学部等一覧) = -1 Then
        ret = 学部等配列作成()
    End If

    
    Select Case MODE
        Case 1
        
        For i = 0 To UBound(PUB_ary学部等一覧)
            If CStr(tmp学部番号) = CStr(PUB_ary学部等一覧(i).学部番号) Then
                If flgEND = False Then
                    flgEND = True
                    PUB_ary専攻.学部番号 = PUB_ary学部等一覧(i).学部番号
                    PUB_ary専攻.学部CODE = PUB_ary学部等一覧(i).学部CODE
                    PUB_ary専攻.学部名 = PUB_ary学部等一覧(i).学部名
                    PUB_ary専攻.学科番号 = PUB_ary学部等一覧(i).学科番号
                    PUB_ary専攻.学科CODE = PUB_ary学部等一覧(i).学科CODE
                    PUB_ary専攻.学科名 = PUB_ary学部等一覧(i).学科名
                    PUB_ary専攻.専攻番号 = PUB_ary学部等一覧(i).専攻番号
                    PUB_ary専攻.専攻CODE = PUB_ary学部等一覧(i).専攻CODE
                    PUB_ary専攻.専攻名 = PUB_ary学部等一覧(i).専攻名
                    PUB_ary専攻.質問CODE = PUB_ary学部等一覧(i).質問CODE
                    bak質問CODE = PUB_ary学部等一覧(i).質問CODE     '重複を計算する
                    質問重複 = 0
                Else
                    If PUB_ary学部等一覧(i).質問CODE <> bak質問CODE Then
                        質問重複 = 1
                    End If
                End If
            End If
            
        
        
        Next i
    
    
       Case 2
        For i = 0 To UBound(PUB_ary学部等一覧)
            If CStr(tmp学部番号) = CStr(PUB_ary学部等一覧(i).学部番号) And _
                CStr(tmp学科番号) = CStr(PUB_ary学部等一覧(i).学科番号) Then
                If flgEND = False Then
                    flgEND = True
                    PUB_ary専攻.学部番号 = PUB_ary学部等一覧(i).学部番号
                    PUB_ary専攻.学部CODE = PUB_ary学部等一覧(i).学部CODE
                    PUB_ary専攻.学部名 = PUB_ary学部等一覧(i).学部名
                    PUB_ary専攻.学科番号 = PUB_ary学部等一覧(i).学科番号
                    PUB_ary専攻.学科CODE = PUB_ary学部等一覧(i).学科CODE
                    PUB_ary専攻.学科名 = PUB_ary学部等一覧(i).学科名
                    PUB_ary専攻.専攻番号 = PUB_ary学部等一覧(i).専攻番号
                    PUB_ary専攻.専攻CODE = PUB_ary学部等一覧(i).専攻CODE
                    PUB_ary専攻.専攻名 = PUB_ary学部等一覧(i).専攻名
                    PUB_ary専攻.質問CODE = PUB_ary学部等一覧(i).質問CODE
                    bak質問CODE = PUB_ary学部等一覧(i).質問CODE     '重複を計算する
                    質問重複 = 0
                Else
                    If PUB_ary学部等一覧(i).質問CODE <> bak質問CODE Then
                        質問重複 = 1
                    End If
                End If
            End If
        Next i
    
    
        Case 3
        For i = 0 To UBound(PUB_ary学部等一覧)
            If CStr(tmp学部番号) = CStr(PUB_ary学部等一覧(i).学部番号) And _
                CStr(tmp学科番号) = CStr(PUB_ary学部等一覧(i).学科番号) And _
                CStr(tmp専攻番号) = CStr(PUB_ary学部等一覧(i).専攻番号) Then
                    PUB_ary専攻.学部番号 = PUB_ary学部等一覧(i).学部番号
                    PUB_ary専攻.学部CODE = PUB_ary学部等一覧(i).学部CODE
                    PUB_ary専攻.学部名 = PUB_ary学部等一覧(i).学部名
                    PUB_ary専攻.学科番号 = PUB_ary学部等一覧(i).学科番号
                    PUB_ary専攻.学科CODE = PUB_ary学部等一覧(i).学科CODE
                    PUB_ary専攻.学科名 = PUB_ary学部等一覧(i).学科名
                    PUB_ary専攻.専攻番号 = PUB_ary学部等一覧(i).専攻番号
                    PUB_ary専攻.専攻CODE = PUB_ary学部等一覧(i).専攻CODE
                    PUB_ary専攻.専攻名 = PUB_ary学部等一覧(i).専攻名
                    PUB_ary専攻.質問CODE = PUB_ary学部等一覧(i).質問CODE
                    質問重複 = 0
                    Exit For
            End If
        Next i
    
    End Select
    
End Function

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Private Sub cmd学部セット_Click()
    
'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
    
    Call 学部等配列作成
End Sub

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

'学部コード変更→学科コードを変更する
Private Sub ComboBox1_Change()
    
'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

    
    '選んだINDEX
    idx = Me.ComboBox1.ListIndex
    
    '選択失敗→終了
    If idx = -1 Then
        Exit Sub
    End If
        
    '選択した学部Combの値を控えておく
    Range("学部番号控") = Me.ComboBox1.List(idx, 0)
    Range("学部CODE控") = Me.ComboBox1.List(idx, 1)
    Range("学部名控") = Me.ComboBox1.List(idx, 2)
    
    
    '学科Comb(ComboBox2)のクリアと項目の追加
    
    ComboBox2.Clear
    'コンボボックスを3列にする
    ComboBox2.ColumnCount = 3
    '3列目を選択された値にする(AA学科)
    ComboBox2.TextColumn = 3
    'それぞれの列幅を指定
    ComboBox2.ColumnWidths = "0;0;60"

    '初期値
    ComboBox2.AddItem
    ComboBox2.List(0, 0) = 0
    ComboBox2.List(0, 1) = "ALL"
    ComboBox2.List(0, 2) = "全て"
    
    
    '選ばれた学部CODE
    学部CODE = Me.ComboBox1.List(idx, 1)
    
    '学部CODEがALLなら、学科CODEもALLのみで終わり
    If 学部CODE = "ALL" Then '全て
        GoTo ComboBox2_SET_INDEX
        Exit Sub
    End If
        
    '学科コンボをセットする
    MODE = 2
    学部番号 = Me.ComboBox1.List(idx, 0)
    Call コンボ配列作成(MODE, 学部番号, 学科番号)
 
    '項目の追加
    
    For i = 0 To UBound(PUB_aryコンボ)
        ComboBox2.AddItem
        ComboBox2.List(i + 1, 0) = PUB_aryコンボ(i).番号
        ComboBox2.List(i + 1, 1) = PUB_aryコンボ(i).CODE
        ComboBox2.List(i + 1, 2) = PUB_aryコンボ(i).名称
    Next i

    
ComboBox2_SET_INDEX:
    
    ComboBox2.ListIndex = 0
End Sub

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

'学科コード変更→専攻コードを変更する
Private Sub ComboBox2_Change()

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
   
    '選んだINDEX
    idx = Me.ComboBox2.ListIndex
    
    '選択失敗→終了
    If idx = -1 Then
        Exit Sub
    End If

    '選択した学科Combの値を控えておく
    Range("学科番号控") = Me.ComboBox2.List(idx, 0)
    Range("学科CODE控") = Me.ComboBox2.List(idx, 1)
    Range("学科名控") = Me.ComboBox2.List(idx, 2)
 
    '専攻Combのクリアと項目の追加
    ComboBox3.Clear
    'コンボボックスを3列にする
    ComboBox3.ColumnCount = 3
    '3列目を選択された値にする(AAコース)
    ComboBox3.TextColumn = 3
    'それぞれの列幅を指定
    ComboBox3.ColumnWidths = "0;0;60"
    
    '初期値
    ComboBox3.AddItem
    ComboBox3.List(0, 0) = 0
    ComboBox3.List(0, 1) = "ALL"
    ComboBox3.List(0, 2) = "全て"
    
    '選ばれた学科CODE
    学科CODE = Me.ComboBox2.List(idx, 1)
    
    '学科CODEがALLなら、専攻CODEもALLのみで終わり
    If 学科CODE = "ALL" Then '全て
        GoTo ComboBox3_SET_INDEX
    End If
    
    
    '学科コンボをセットする
    MODE = 3
    学部番号 = Range("F21")
    学科番号 = Me.ComboBox2.List(idx, 0)
    Call コンボ配列作成(MODE, 学部番号, 学科番号)
 
    '項目の追加
    For i = 0 To UBound(PUB_aryコンボ)
        ComboBox3.AddItem
        ComboBox3.List(i + 1, 0) = PUB_aryコンボ(i).番号
        ComboBox3.List(i + 1, 1) = PUB_aryコンボ(i).CODE
        ComboBox3.List(i + 1, 2) = PUB_aryコンボ(i).名称
    Next i

ComboBox3_SET_INDEX:

    ComboBox3.ListIndex = 0


End Sub

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Private Sub ComboBox3_Change()

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

    '選んだINDEX
    idx = Me.ComboBox3.ListIndex
    
    '選択失敗→終了
    If idx = -1 Then
        Exit Sub
    End If
    '選択した学部Combの値を控えておく
        
    
    Range("専攻番号控") = Me.ComboBox3.List(idx, 0)
    Range("専攻CODE控") = Me.ComboBox3.List(idx, 1)
    Range("専攻名控") = Me.ComboBox3.List(idx, 2)
End Sub



'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Function 学部等配列作成()

'[cmd学部セット]から来た
'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
'PUB_ary学部等検索()
'PUB_ary学部等一覧()

Dim sheet学部 As Worksheet
Set sheet学部 = ThisWorkbook.Sheets("学部学科専攻new")

''表の最初と最後の行
Dim hajR, owaR

'-------------------------------
''表の出現順に読み込む一時配列
'-------------------------------
Dim ary学部番号()
Dim ary学部CODE()
Dim ary学部名()
Dim ary学科番号()
Dim ary学科CODE()
Dim ary学科名()
Dim ary専攻番号()
Dim ary専攻CODE()
Dim ary専攻名()
Dim ary質問CODE()

'=============================================

'変数

'=============================================
'-------------------------------
'表の列番号
'-------------------------------
c学部番号 = 2
c学部CODE = 3
c学部名 = 4
c学科番号 = 5
c学科CODE = 6
c学科名 = 7
c専攻番号 = 8
c専攻CODE = 9
c専攻名 = 10
c質問CODE = 11

'=============================================

'初期処理

'=============================================

'-------------------------------
'表の最後の行を取得
'-------------------------------
hajR = 6    '-----------最初(見出しは含めない

r = hajR
With sheet学部
    While CStr(.Cells(r + 1, c学部番号)) & _
CStr(.Cells(r + 1, c学部CODE)) & _
CStr(.Cells(r + 1, c学部名)) & _
CStr(.Cells(r + 1, c学科番号)) & _
CStr(.Cells(r + 1, c学科CODE)) & _
CStr(.Cells(r + 1, c学科名)) & _
CStr(.Cells(r + 1, c専攻番号)) & _
CStr(.Cells(r + 1, c専攻CODE)) & _
CStr(.Cells(r + 1, c専攻名)) & _
CStr(.Cells(r + 1, c質問CODE)) > ""

    r = r + 1
Wend
owaR = r    '-------------最後



'-------------------------------
'学部、学科、専攻番号の最大値を取得
'一時配列に保存
'-------------------------------
max学部番号 = -1
max学科番号 = -1
max専攻番号 = -1

For r = hajR To owaR
    i = r - hajR
    '--------------------
    dmy = .Cells(r, c学部番号)
    If dmy = "" Then
        dmy = -1
    End If
    If max学部番号 < dmy Then
        max学部番号 = dmy
    End If
    '--------------------
     dmy = .Cells(r, c学科番号)
    If dmy = "" Then
        dmy = -1
    End If
    If max学科番号 < dmy Then
        max学科番号 = dmy
    End If
    '--------------------
     dmy = .Cells(r, c専攻番号)
    If dmy = "" Then
        dmy = -1
    End If
    If max専攻番号 < dmy Then
        max専攻番号 = dmy
    End If
    '--------------------
    
    '一時配列に
    '一行ずつ、一項目ずつ配列に入れる
    ReDim Preserve ary学部番号(i)
    ReDim Preserve ary学部CODE(i)
    ReDim Preserve ary学部名(i)
    ReDim Preserve ary学科番号(i)
    ReDim Preserve ary学科CODE(i)
    ReDim Preserve ary学科名(i)
    ReDim Preserve ary専攻番号(i)
    ReDim Preserve ary専攻CODE(i)
    ReDim Preserve ary専攻名(i)
    ReDim Preserve ary質問CODE(i)

    ary学部番号(i) = .Cells(r, c学部番号)
    ary学部CODE(i) = .Cells(r, c学部CODE)
    ary学部名(i) = .Cells(r, c学部名)
    ary学科番号(i) = .Cells(r, c学科番号)
    ary学科CODE(i) = .Cells(r, c学科CODE)
    ary学科名(i) = .Cells(r, c学科名)
    ary専攻番号(i) = .Cells(r, c専攻番号)
    ary専攻CODE(i) = .Cells(r, c専攻CODE)
    ary専攻名(i) = .Cells(r, c専攻名)
    ary質問CODE(i) = .Cells(r, c質問CODE)
Next r


'取得最大値で検索用 動的配列を設定
ReDim Preserve PUB_ary学部等検索(max学部番号, max学科番号, max専攻番号)

'行数で一覧用動的配列を設定
ReDim Preserve PUB_ary学部等一覧(UBound(ary学部番号))


'--------------------------------------
'一時配列を項目ごと配列を整理する
'空欄に必要な数字を入れたりする
'一行目のみ別に処理する
'--------------------------------------

'1行目(I=0)だけ特別
i = 0
If ary学部番号(i) = "" Or ary学部番号(i) = 0 Then
    msg = "1行目の学部番号が空白かゼロです。不正なデータですので作業を終了します。"
    GoTo 学部等配列作成_ERR
ElseIf ary学部CODE(i) = "" Or ary学部CODE(i) = 0 Then
    msg = "1行目の学部CODEが空白かゼロです。不正なデータですので作業を終了します。"
    GoTo 学部等配列作成_ERR
ElseIf ary学部名(i) = "" Or ary学部名(i) = 0 Then
    msg = "1行目の学部名が空白かゼロです。不正なデータですので作業を終了します。"
    GoTo 学部等配列作成_ERR
End If

If ary学科番号(i) = "" Then
    ary学科番号(i) = 0
End If

If ary専攻番号(i) = "" Then
    ary専攻番号(i) = 0
End If

For i = 1 To UBound(ary学部番号)
    
    If ary学部番号(i) = "" Then
        ary学部番号(i) = ary学部番号(i - 1)
    End If
    If ary学部CODE(i) = "" Then
        ary学部CODE(i) = ary学部CODE(i - 1)
    End If
    
    If ary学部名(i) = "" Then
        ary学部名(i) = ary学部名(i - 1)
    End If
    If ary学科番号(i) = "" Then
        If (ary学部番号(i) = ary学部番号(i - 1)) Then
            ary学科番号(i) = ary学科番号(i - 1)
        Else
            ary学科番号(i) = 0
        End If
    End If
    If ary学科CODE(i) = "" And (ary学部番号(i) = ary学部番号(i - 1)) Then
        ary学科CODE(i) = ary学科CODE(i - 1)
    End If
    If ary学科名(i) = "" And (ary学部番号(i) = ary学部番号(i - 1)) Then
        ary学科名(i) = ary学科名(i - 1)
    End If
    
    If ary専攻番号(i) = "" Then
        If (ary学科番号(i) = ary学科番号(i - 1)) Then
            ary専攻番号(i) = ary専攻番号(i - 1)
        Else
            ary専攻番号(i) = 0
        End If
    End If
Next i

'*******チェックライト***********
Range("o6").CurrentRegion.Clear

For i = 0 To UBound(ary学部番号)
r = i + 6
    .Cells(r, 15) = ary学部番号(i)
    .Cells(r, 16) = ary学部CODE(i)
    .Cells(r, 17) = ary学部名(i)
    .Cells(r, 18) = ary学科番号(i)
    .Cells(r, 19) = ary学科CODE(i)
    .Cells(r, 20) = ary学科名(i)
    .Cells(r, 21) = ary専攻番号(i)
    .Cells(r, 22) = ary専攻CODE(i)
    .Cells(r, 23) = ary専攻名(i)
    .Cells(r, 24) = ary質問CODE(i)

Next i
'*******************************
End With
    
'--------------------------------------
'一時配列からPUB配列に値を入れる
'--------------------------------------
    
For i = 0 To UBound(ary学部番号)
    PUB_ary学部等検索(ary学部番号(i), ary学科番号(i), ary専攻番号(i)).学部番号 = ary学部番号(i)
    PUB_ary学部等検索(ary学部番号(i), ary学科番号(i), ary専攻番号(i)).学部CODE = ary学部CODE(i)
    PUB_ary学部等検索(ary学部番号(i), ary学科番号(i), ary専攻番号(i)).学部名 = ary学部名(i)
    PUB_ary学部等検索(ary学部番号(i), ary学科番号(i), ary専攻番号(i)).学科番号 = ary学科番号(i)
    PUB_ary学部等検索(ary学部番号(i), ary学科番号(i), ary専攻番号(i)).学科CODE = ary学科CODE(i)
    PUB_ary学部等検索(ary学部番号(i), ary学科番号(i), ary専攻番号(i)).学科名 = ary学科名(i)
    PUB_ary学部等検索(ary学部番号(i), ary学科番号(i), ary専攻番号(i)).専攻番号 = ary専攻番号(i)
    PUB_ary学部等検索(ary学部番号(i), ary学科番号(i), ary専攻番号(i)).専攻CODE = ary専攻CODE(i)
    PUB_ary学部等検索(ary学部番号(i), ary学科番号(i), ary専攻番号(i)).専攻名 = ary専攻名(i)
    PUB_ary学部等検索(ary学部番号(i), ary学科番号(i), ary専攻番号(i)).質問CODE = ary質問CODE(i)


    PUB_ary学部等一覧(i).学部番号 = ary学部番号(i)
    PUB_ary学部等一覧(i).学部CODE = ary学部CODE(i)
    PUB_ary学部等一覧(i).学部名 = ary学部名(i)
    PUB_ary学部等一覧(i).学科番号 = ary学科番号(i)
    PUB_ary学部等一覧(i).学科CODE = ary学科CODE(i)
    PUB_ary学部等一覧(i).学科名 = ary学科名(i)
    PUB_ary学部等一覧(i).専攻番号 = ary専攻番号(i)
    PUB_ary学部等一覧(i).専攻CODE = ary専攻CODE(i)
    PUB_ary学部等一覧(i).専攻名 = ary専攻名(i)
    PUB_ary学部等一覧(i).質問CODE = ary質問CODE(i)


Next i
    
''''For i = 0 To UBound(PUB_ary学部等一覧)
''''
''''
''''        Debug.Print CStr(i) & "-", _
''''        PUB_ary学部等一覧(i).学部CODE, _
''''        PUB_ary学部等一覧(i).学部名, _
''''        PUB_ary学部等一覧(i).学科番号, _
''''        PUB_ary学部等一覧(i).学科CODE, _
''''        PUB_ary学部等一覧(i).学科名, _
''''        PUB_ary学部等一覧(i).専攻番号, _
''''        PUB_ary学部等一覧(i).専攻CODE, _
''''        PUB_ary学部等一覧(i).専攻名, _
''''        PUB_ary学部等一覧(i).質問CODE
''''
''''
''''Next i

学部等配列作成 = ""
Exit Function

学部等配列作成_ERR:
学部等配列作成 = Err.msg

End Function

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Private Sub cmdコンボ学部準備_Click()

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
    
    MODE = 1
    Call コンボ配列作成(MODE, 学部番号, 学科番号)
    
   
    ComboBox1.Clear
    'コンボボックスを3列にする
    ComboBox1.ColumnCount = 3
    '3列目を選択された値にする(C学部)
    ComboBox1.TextColumn = 3
    'それぞれの列幅を指定
    ComboBox1.ColumnWidths = "0;0;60"
    
    '項目の追加
    ComboBox1.AddItem
    ComboBox1.List(0, 0) = 0
    ComboBox1.List(0, 1) = "ALL"
    ComboBox1.List(0, 2) = "全て"

  
    For i = 0 To UBound(PUB_aryコンボ)
       ComboBox1.AddItem
        ComboBox1.List(i + 1, 0) = PUB_aryコンボ(i).番号
        ComboBox1.List(i + 1, 1) = PUB_aryコンボ(i).CODE
        ComboBox1.List(i + 1, 2) = PUB_aryコンボ(i).名称
    Next i
    
    ComboBox1.ListIndex = 0
    
    

End Sub

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Sub コンボ配列作成(MODE, my学部番号, my学科番号)

'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
   
   If (Not PUB_ary学部等一覧) = -1 Then 'PUB_ary学部等検索に値がセットされていないので、まず作成
        ret = 学部等配列作成()
    End If
    
    'コンボ配列をクリア
    ReDim PUB_aryコンボ(0)
    
    Select Case MODE
        Case 1  '学部一覧
            bak学部番号 = -1
            cnt = 0
            For i = 0 To UBound(PUB_ary学部等一覧)
                If CInt(PUB_ary学部等一覧(i).学部番号) <> CInt(bak学部番号) Then
                    ReDim Preserve PUB_aryコンボ(cnt)
                    PUB_aryコンボ(cnt).番号 = PUB_ary学部等一覧(i).学部番号
                    PUB_aryコンボ(cnt).CODE = PUB_ary学部等一覧(i).学部CODE
                    PUB_aryコンボ(cnt).名称 = PUB_ary学部等一覧(i).学部名
                    cnt = cnt + 1
                    bak学部番号 = PUB_ary学部等一覧(i).学部番号
                End If
            Next i
        Case 2  '学科一覧
            bak学科番号 = -1
            cnt = 0
            For i = 0 To UBound(PUB_ary学部等一覧)
            Debug.Print i, PUB_ary学部等一覧(i).学部番号
                If CInt(PUB_ary学部等一覧(i).学部番号) = CInt(my学部番号) Then
                    If CInt(PUB_ary学部等一覧(i).学科番号) <> CInt(bak学科番号) And _
                    CInt(PUB_ary学部等一覧(i).学科番号) <> 0 Then
                        ReDim Preserve PUB_aryコンボ(cnt)
                        PUB_aryコンボ(cnt).番号 = PUB_ary学部等一覧(i).学科番号
                        PUB_aryコンボ(cnt).CODE = PUB_ary学部等一覧(i).学科CODE
                        PUB_aryコンボ(cnt).名称 = PUB_ary学部等一覧(i).学科名
                        cnt = cnt + 1
                        bak学科番号 = PUB_ary学部等一覧(i).学科番号
                    End If
                End If
            Next i

        Case 3  '専攻一覧
            bak専攻番号 = -1
            cnt = 0
            For i = 0 To UBound(PUB_ary学部等一覧)
                If CInt(PUB_ary学部等一覧(i).学部番号) = CInt(my学部番号) And _
                   CInt(PUB_ary学部等一覧(i).学科番号) = CInt(my学科番号) And _
                   CInt(PUB_ary学部等一覧(i).専攻番号) <> 0 Then
                    ReDim Preserve PUB_aryコンボ(cnt)
                    PUB_aryコンボ(cnt).番号 = PUB_ary学部等一覧(i).専攻番号
                    PUB_aryコンボ(cnt).CODE = PUB_ary学部等一覧(i).専攻CODE
                    PUB_aryコンボ(cnt).名称 = PUB_ary学部等一覧(i).専攻名
                    cnt = cnt + 1
                 End If
            Next i

        Case Else
        End Select
        
End Sub