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