<
Range("A2").CurrentRegion
「Ctrl + Shift + :」 にショートカット
-------------------------------------
2020-08-04
セル範囲(Range)を取得する方法10選
Range・Cells 入門・まとめ 読みやすいコードの書き方 VBA
この表のオレンジの部分を取得しましょう。
取得したいRangeの範囲
VBAをやっていて、この処理をしたことが無い人はいないのでは？
ってくらいよくある処理ですよね。
単純に書こうとすれば、初心者でもすぐ書けるような方法がいくらでもあるので、
普段はあまり考えない部分かもしれません。
ですがこの処理の書き方はいろいろなやり方があり、
コードの読みやすさの、1つのポイントになる部分です。
読みやすさ、メンテのしやすさ、バグの書きづらさなど、
追求しようと思えば、とても考えがいのある処理です。
自分の知識の確認の意味でも、ちょっと考察してみましょう。
Range("セルアドレス")で指定する
Range("○○")を変数で指定できるようにする
Range(Cells(左上), Cells(右下))で指定する
ちょっと寄り道：Enum定数で列番号を定義
Resize(データ数)で取得する
Offsetで取得する
表全体の範囲から、列部分を切り取って取得する
Columnsで取得する
Intersectメソッドで取得する
表全体を簡単に取得するプロパティ
CurrentRegionプロパティ
ワークシート.AutoFilter.Range
見出しを除外する方法
完成形
おまけ：学んだコードは関数化してとっておく
おまけ：1つ忘れていたメソッドを付け足し
Range("セルアドレス")で指定する
Range("E3:E7")
まずどストレートにこれ。基本中の基本ですね。
「初心者向け」と見せかけて、単純な読みやすさでは一番なので、
「完全に固定の範囲」であれば、上級者になっても普通に使うと思います。
Range(○○)はいろんな書き方ができますね。
やる人はいないと思いますが、
Range("E3,E4,E5,E6,E7")
でもいけます。
意外と知らない方もいるかもしれませんが、
Range("E3","E7")
でも同じエリアを取得できますし、
Range("E3:E4","E6:E7")
と、範囲から範囲まででも行けたりします。
まあこの辺は遊びというか、実際にこれらの指定方法で何かマクロを組んだことはほとんどないですね(笑)
一応たまに使うものとしては、「A1セルからこの表までの全体」を取得したいときに、
Range(セル範囲, セル範囲)パターンが使えます。
Range("A1", "A2:E7")
これでA1:E7を取得することができ、
ここを印刷範囲にしたり、.Rows.Countで最終行を取得したりできますね。
Range("○○")を変数で指定できるようにする
取得したいRangeの範囲
先ほど「完全に固定の範囲」であればRange("E3:E7")を使うと書きました。
ですが、今回の範囲はどう見ても「完全に固定」ではないですね。
次のくだものが売れていかないと、お店はやっていけません。
プログラミングの極意は「動的なデータにどう対応するか」ですので、
まずは一番基本となる「データがどこまで入っているか」に対応しましょう。
ここから先は、「E7」ではなく、
Dim 最終行 As Long
という変数に最終行を取得して、それを使うことにします。
最終行番号の取得コードは、長くなるので別の機会に。
With ActiveSheet
最終行 = .Cells(.Rows.Count, 5).End(XlUp).Row
最終行 = .UsedRange.Rows.Count + .UsedRange.Row - 1
最終行 = .Range("A1", .Autofilter.Range).Rows.Count
End With
↑どれでも好きなものをイメージして先に進んでください。
Range("セルアドレス")で動的データに対応する場合は、
Range("E3:E" & 最終行)
こんな感じで、文字列結合を利用することができます。
ひとまずこれで、データがどんどん追加されていくことには自動対応できますね。
Range(Cells(左上), Cells(右下))で指定する
さてここからはプログラムらしくなっていきます。
Range(Cells(3, 5), Cells(7, 5))
これでE3:E7を取得することができます。
セル範囲を数値で表そうと思ったら、これが一番基本だと思います。
もちろんこんな数字ベタ打ちでは何の意味もなく、
「目的は変数・定数を使えるように」です。
変数と定数を使った例がこんな感じです↓
取得したいRangeの範囲
' モジュール上部にて
Const R1stくだもの表 = 3
Const CNoくだもの表_No = 1
Const CNoくだもの表_品物 = 2
Const CNoくだもの表_単価 = 3
Const CNoくだもの表_数量 = 4
Const CNoくだもの表_売上 = 5
' コード内にて
Dim RLastくだもの表 As Long
RLastくだもの表 = さっきイメージした最終行取得コード
' E3:E7を取得するコード
Range(Cells(R1stくだもの表, CNoくだもの表_売上) _
, Cells(RLastくだもの表, CNoくだもの表_売上))
これで、4つの数字を全部定数・変数にできました。
最後の式に値を代入してみれば、
Range(Cells(3, 5), Cells(7, 5))
になります。
ここまでくれば、「データがどこまで入っているか」という実行時の対応だけでなく、
表の上部に余白の行を挿入したい
品物と単価の間に購入日の列を挿入したい
といった、表自体の改修時にも、定数をいじるだけで対応できるようになります。
ひとまず、「Rangeプロパティで表のデータ部分をもって来よう」というマクロを、
メンテナンス性を意識して書く場合は、これが基本の形だと思います。
まあここまでやるかどうかは、マクロの規模やデータの重要度と相談してください。
単発の業務で使う表なら、
Range("E3:E" & 最終行)
でも十分動的です。
逆にいろいろな業務で共有する重要なデータなどでは、
この「売上を意味するE」が、たくさんのマクロに登場するでしょう。
全部"E"とベタ打ちしていると、列を挿入して売り上げがF列になったときに地獄を見ますが、定数化している場合は
Const CNoくだもの表_売上 = 5
この5を6に変えるだけでマクロの改修が完了します。
この辺を吟味して、どこまで丁寧にデータを定数化するかを決めてください。
ちょっと寄り道：Enum定数で列番号を定義
先ほどの定数で、列番号を定義していた
Const CNoくだもの表_No = 1
Const CNoくだもの表_品物 = 2
Const CNoくだもの表_単価 = 3
Const CNoくだもの表_数量 = 4
Const CNoくだもの表_売上 = 5
この部分は、列挙型定数Enumを用いて、
Enum CNoくだもの表
No = 1
品物 ' ここから↓が2,3,4…と連番で定義されるしくみ
単価
数量
売上
End Enum
こう書き換えることができます。
その場合のRangeの指定はこんな感じ。
Range(Cells(R1stくだもの表, CNoくだもの表.売上) _
, Cells(RLastくだもの表, CNoくだもの表.売上))
_ が . に変わっただけですね。
入力は、
Enumの選択肢
と、本体の名前「CNoくだもの表」の後は選択肢から選べるので、サクサク入力できます。
列挙型Enumは、単にLong型の定数をまとめて持っておく機能ですが、
「番号を省略した場合は連番」という仕様が、列番号の定数化に超便利です。
先ほど例に挙げた「品物と単価の間に購入日の列を挿入」する場合、
Enum CNoくだもの表
No = 1
品物
購入日 ' これを書き加えると、
単価 ' ここから↓が1ずつ足される神仕様
数量
売上 ' さっきの例の通り、5が6になっている
End Enum
これで済むという、ある意味列番号を定義するために生まれてきたやつです。
Enumを初めて知った方は、この機会に覚えてしまいましょう。
Resize(データ数)で取得する
取得したいRangeの範囲
さて、定数化がようやく終わりましたので、
やっとこさ本題のRange取得プロパティを紹介できますね。
ここからはサクサク行きましょう。
まずはResizeプロパティから。
Resize(行数,列数)でセル範囲を拡張できます。
それを活用して、E3:E7を取得するにはこう書きます↓
' データの数を計算しておく
Dim データ数 As Long
データ数 = RLastくだもの表 - R1stくだもの表 + 1
' E3:E7はこれ
Range("E3").Resize(データ数, 1)
' 列数は変えないので省略も可能
Range("E3").Resize(データ数)
' 定数を使うならこう
Cells(R1stくだもの表, CNoくだもの表.売上).Resize(データ数)
「一番目のセルからデータの数だけ下へ伸ばした範囲」という書き方が、
直感的にとてもわかりやすいため、素晴らしく読みやすいコードになります。
しかも一度取得した「データ数」は使いまわせるため、
みかんの売上合計 = WorksheetFunction.Sumif _
(Range("B3").Resize(データ数), "みかん", Range("E3").Resize(データ数))
のように、SUMIF(B列,みかん,E列)がこんなに読みやすく書けます。
Resizeを使いこなせると、Rangeの扱いにかなり幅が出ますので、
是非習得していってください。
例えば今回の表全体であるA3:E8なんかも、
Range("A3").Resize(データ数, 表の列数)
で取得することができます。
Offsetで取得する
Resizeの次は、親戚のOffsetを紹介します。
Rangeオブジェクト.Offset(行数, 列数)で、
Rangeオブジェクトを「同じ大きさのまま指定の数分ズラす」ことができます。
' D列の表エリアを右にひとつズラしてE3:E8を取得する
Range("D3:D7").Offset(0, 1)
この例のように、大きさが変わらないというのがOffsetのいいところで、
例えばさっきのSUMIFを例にとると、
Set 売上列 = Range("E3").Resize(データ数)
みかんの合計 = WorksheetFunction.Sumif(売上列.Offset(0, -3), "みかん", 売上列)
こんな書き方をすることができます。
読みやすくはないですが、書くのはかなり速そうですね。
定数が使えていないことからもわかる通り、
Offsetは書きやすいけど読みにくいプロパティです。
Resizeと組み合わせると、変幻自在にRangeを扱えるようになりますが、
その自在っぷりに未来の自分が惑わされる可能性があります。
ご利用は計画的に。
表全体の範囲から、列部分を切り取って取得する
取得したいRangeの範囲
今まで挙げた例は、E3からE7までをくっつけたり、動かしたりといった、
いわば「積み木」のような取得方法でした。
これとは異なるアプローチのセル範囲の取得方法として、
「表全体という長方形の板から、E列部分を切り取る」
という、のこぎり的な方法もありますのでご紹介します。
Columnsで取得する
表全体を表すRange("A3:E7")を使うと、こんな感じに書くことができます。
Range("A3:E7").Columns("E")
Range("A3:E7").Columns(CNoくだもの表.品物)
Columnsプロパティは、よくある「Worksheet」を親にすると列全体を指します。
省略時はActiveSheetの列全体を取ってきますよね。
このColumnsプロパティですが、実はRangeオブジェクトを親にすることもでき、
「セル範囲が入っているRangeオブジェクト.Columns(列番号)」とすると、
「そのセル範囲の第○列目」を取ってくることができます。
書いたコードの見た目も、「くだもの表の品物列」って感じで、とてもいいですね。
ただしこの方法、データがA列から始まっていると、
かなり読みやすくていい方法なんですが、
Columnsの罠
この表のように、B列以降から表が始まる場合は注意が必要です。
この場合、
Range("B3:E7").Columns("E")
これはシート上で言うところのF列を指してしまいます。
B列からみたE列のようなイメージになっちゃうため、
A列始まりでない表では、その分ズレちゃうんですね。
ということで、Columnsの性質を覚えつつ、本命は↓へ。
Intersectメソッドで取得する
Intersectメソッドは、引数に渡すセル範囲が「重なっている部分」を返します。
今回の場合は、「表全体の長方形」と「E列全体」の重なる部分を取ると、
画像のように売上列のブロックを取得することができます。
Intersectの例
こんな感じで範囲を取得します。「交差部分」と呼んだりしますね。
これなら表エリアの開始列がA列かどうかに関わらず、
「第5列」なら5で行けますので、定数との相性も良いです↓
Intersect(Range("B3:E7"), Columns(CNoくだもの表.売上))
私はEnumを愛しているので、Enumと相性のよいこれが一番好きです。
表全体を簡単に取得するプロパティ
さて、わざわざこれらの「のこぎり」を便利と紹介したのは、
元の板となるRange("A2:E7")を、簡単に取得するいいプロパティがあるからです。
まずは以下の2つを覚えておきましょう。
CurrentRegionプロパティ
あるセルを含む、表っぽい部分を自動取得してくれます。
CurrentRegionのサンプル
この機能は「アクティブセル領域」と呼び、
「Ctrl + Shift + :」 にショートカットがセットされていますので、
試しにやってみてください。
空の行だったり、表が複数隣接していない限りは、
手っ取り早く表のセル範囲を取得できる優秀なプロパティです。
今回の例では、
Range("A2").CurrentRegion
でRange("A2:E7")を取得できます。
というのは嘘で、Range("A1:E7")を取得しやがります。
アホの子Region
大変便利なCurrentRegionさんですが、
今回のように、「表のタイトル」などをよくアホの子しますので、
ご利用は計画的に。
ワークシート.AutoFilter.Range
ワークシート.AutoFilter.Rangeで、オートフィルターのかかっているエリア全体を取得できます。
親のオブジェクトが「ワークシート」なので、
どこか起点となるセルを探さなくてもいいのがメリット。
Worksheets("くだもの売上表").AutoFilter.Range
これで"A2:E7"を取得できます。
セル番地が一つも出て来ないコードにできますね。
ユーザー側で設置しちゃえるので、Excelがアホの子しないのもメリットです。
（ユーザーがアホの子する危険がありますが）
-------------------------------------
For i = 0 To max学部番号
For j = 0 To max学科番号
For k = 0 To max専攻番号
Debug.Print CStr(i) & "-" & CStr(j) & "-" & CStr(k), PUB_ary学部等一覧(i, j, k).学部番号, _
PUB_ary学部等一覧(i, j, k).学部CODE, _
PUB_ary学部等一覧(i, j, k).学部名, _
PUB_ary学部等一覧(i, j, k).学科番号, _
PUB_ary学部等一覧(i, j, k).学科CODE, _
PUB_ary学部等一覧(i, j, k).学科名, _
PUB_ary学部等一覧(i, j, k).専攻番号, _
PUB_ary学部等一覧(i, j, k).専攻CODE, _
PUB_ary学部等一覧(i, j, k).専攻名, _
PUB_ary学部等一覧(i, j, k).質問CODE
Next k
Next j
Next i
--------------------------学部学科専攻new
Function func学部一覧を作る()
'戻り値は
End Function
'学部コンボボックス設定
Private Sub cmd学部セット_Click()
'PUB_ary学部等一覧()を作る
'戻り値はエラーメッセージか空
ret = func学部一覧配列作成()
'PUB_ary学部等一覧()から学部配列作成(PUB_aryコンボ())
'戻り値はPUB_aryコンボ()
ret = funcコンボボックス(1, "", "", "")
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) = "全て"
MODE = 1
学部CODE = 0
学科ODE = 0
'学部一覧を作る
ret = func学部学科専門一覧(MODE, 学部CODE, 学科CODE)
If ret = True Then
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
End If
ComboBox1.ListIndex = 0
End Sub
Function funcコンボボックス(MODE, 学部番号, 学科番号, 専攻番号)
Select Case MODE
Case 1
cnt = 0: back = -1
For i = 0 To UBound(PUB_ary学部等一覧, 1)
For j = 0 To UBound(PUB_ary学部等一覧, 2)
For k = 0 To UBound(PUB_ary学部等一覧, 3)
If PUB_ary学部等一覧(i, j, k).学部番号 <> back And Not IsEmpty(PUB_ary学部等一覧(i, j, k).学部番号) Then
ReDim PUB_aryコンボ(cnt)
PUB_aryコンボ(cnt).番号 = PUB_ary学部等一覧(i, j, k).学部番号
PUB_aryコンボ(cnt).CODE = PUB_ary学部等一覧(i, j, k).学部CODE
PUB_aryコンボ(cnt).名称 = PUB_ary学部等一覧(i, j, k).学部名
End If
Next k
Next j
Next i
Case 2
Case 3
Case Else
End Select
End Function
Function func学部一覧配列作成()
'Public PUB_ary学部等一覧() As type専攻
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
MsgBox CStr(max学部番号) & "/" & CStr(max学科番号) & "/" & CStr(max専攻番号)
'取得最大値で動的配列を設定
ReDim Preserve PUB_ary学部等一覧(max学部番号, max学科番号, max専攻番号)
For i = 0 To max学科番号
'項目ごと配列を整理する。空欄に必要な数字を入れたりする。
'一行目のみ別に処理する
'
'1行目(I=0)だけ特別
i = 0
If ary学部番号(i) = "" Or ary学部番号(i) = 0 Then
msg = "1行目の学部番号が空白かゼロです。不正なデータですので作業を終了します。"
GoTo func学部一覧配列作成_ERR
ElseIf ary学部CODE(i) = "" Or ary学部CODE(i) = 0 Then
msg = "1行目の学部CODEが空白かゼロです。不正なデータですので作業を終了します。"
GoTo func学部一覧配列作成_ERR
ElseIf ary学部名(i) = "" Or ary学部名(i) = 0 Then
msg = "1行目の学部名が空白かゼロです。不正なデータですので作業を終了します。"
GoTo func学部一覧配列作成_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
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
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)
Next i
func学部一覧配列作成 = ""
Exit Function
'------------------------------------------------------------------------------------------------
r開始 = sheet学部.Range("学部番号").Row + 1
r = r開始: chk = "A"
While chk <> ""
chk = sheet学部.Cells(r, c学部CODE) & sheet学部.Cells(r, c学科CODE) & sheet学部.Cells(r, c専攻CODE)
r = r + 1
Wend
r終了 = r - 2
If MODE = 1 Then
GoSub 学部表
' aaa = ""
' For i = 0 To UBound(PUB_aryコンボ)
' aaa = aaa & Str(i) & " " & PUB_aryコンボ(i).番号 & " " & PUB_aryコンボ(i).CODE & " " & PUB_aryコンボ(i).名称 & vbCrLf
' Next i
' MsgBox aaa
End If
If MODE = 2 Then
GoSub 学科表
' aaa = ""
' For i = 0 To UBound(PUB_aryコンボ)
' aaa = aaa & Str(i) & " " & PUB_aryコンボ(i).番号 & " " & PUB_aryコンボ(i).CODE & " " & PUB_aryコンボ(i).名称 & vbCrLf
' Next i
' MsgBox aaa
End If
If MODE = 3 Then
GoSub 専攻表
' aaa = ""
' For i = 0 To UBound(PUB_aryコンボ)
' aaa = aaa & Str(i) & " " & PUB_aryコンボ(i).番号 & " " & PUB_aryコンボ(i).CODE & " " & PUB_aryコンボ(i).名称 & vbCrLf
' Next i
' MsgBox aaa
End If
Exit Function
'==================================================
学部表:
'==================================================
my学部CODE = ""
i = 0
For r = r開始 To r終了
If sheet学部.Cells(r, c学部CODE) <> my学部CODE Then
ReDim Preserve PUB_aryコンボ(i)
PUB_aryコンボ(i).番号 = sheet学部.Cells(r, c学部番号)
PUB_aryコンボ(i).CODE = sheet学部.Cells(r, c学部CODE)
PUB_aryコンボ(i).名称 = sheet学部.Cells(r, c学部名)
PUB_aryコンボ(i).質問 = sheet学部.Cells(r, c質問CODE)
my学部CODE = PUB_aryコンボ(i).CODE
i = i + 1
End If
Next r
Return
'==================================================
学科表:
'==================================================
my学科CODE = ""
i = 0
For r = r開始 To r終了
If sheet学部.Cells(r, c学部CODE) = from学部CODE Then '指定学部コードなら作業
If sheet学部.Cells(r, c学科CODE) <> my学科CODE Then
ReDim Preserve PUB_aryコンボ(i)
PUB_aryコンボ(i).番号 = sheet学部.Cells(r, c学科番号)
PUB_aryコンボ(i).CODE = sheet学部.Cells(r, c学科CODE)
PUB_aryコンボ(i).名称 = sheet学部.Cells(r, c学科名)
PUB_aryコンボ(i).質問 = sheet学部.Cells(r, c質問CODE)
my学科CODE = PUB_aryコンボ(i).CODE
i = i + 1
End If
End If
Next r
Return
'==================================================
専攻表:
'==================================================
i = 0
For r = r開始 To r終了
If (sheet学部.Cells(r, c学部CODE) = from学部CODE) And _
(Str(sheet学部.Cells(r, c学科CODE)) = Str(from学科CODE)) Then
ReDim Preserve PUB_aryコンボ(i)
PUB_aryコンボ(i).番号 = sheet学部.Cells(r, c専攻番号)
PUB_aryコンボ(i).CODE = sheet学部.Cells(r, c専攻CODE)
PUB_aryコンボ(i).名称 = sheet学部.Cells(r, c専攻名)
PUB_aryコンボ(i).質問 = sheet学部.Cells(r, c質問CODE)
i = i + 1
End If
Next r
Return
Exit Function
func学部一覧配列作成_ERR:
MsgBox msg
func学部一覧配列作成 = msg
End Function
Private Sub cmd2_Click()
'つくりゅボタン
chk学部 = Me.CheckBox1
chk学科 = Me.CheckBox2
chk専攻 = Me.CheckBox3
my学部CODE = Range("G21")
my学科CODE = Range("G24")
my専攻CODE = Range("G27")
'-------------
'学部を作る
'-------------
MODE = 1
If my学部CODE = "ALL" Then
学部CODE = ""
Else
学科CODE = my学部CODE '←これで作れるように !
End If
ret = func学部学科専門一覧(MODE, 学部CODE, 学科CODE)
For i = 0 To UBound(PUB_aryコンボ)
ReDim Preserve Pub_ary学部(i)
Pub_ary学部(i).学部番号 = PUB_aryコンボ(i).番号
Pub_ary学部(i).学部CODE = PUB_aryコンボ(i).CODE
Pub_ary学部(i).学部名 = PUB_aryコンボ(i).名称
Pub_ary学部(i).質問CODE = PUB_aryコンボ(i).質問 '--------------------複数の時に
Next i
'学科を作る
i = 0
If my学科CODE <> "ALL" Then
ReDim Preserve PUB_ary学科(i)
ary学科(i) = my学科CODE
Else '全部
MODE = 2
For i = 0 To UBound(ary_学部)
学部CODE = my学部CODE
学科CODE = ""
ret = func学部学科専門一覧(MODE, 学部CODE, 学科CODE)
For i = 0 To UBound(PUB_aryコンボ)
ReDim Preserve Pub_ary学部(i)
Pub_ary学部(i).学部番号 = Pub_ary学部(i).学部番号
Pub_ary学部(i).学部CODE = Pub_ary学部(i).学部CODE
Pub_ary学部(i).学部名 = Pub_ary学部(i).学部名
Pub_ary学部(i).学部番号 = PUB_aryコンボ(i).番号
Pub_ary学部(i).学部CODE = PUB_aryコンボ(i).CODE
Pub_ary学部(i).学部名 = PUB_aryコンボ(i).名称
Pub_ary学部(i).質問CODE = PUB_aryコンボ(i).質問 '--------------------複数の時に
Next i
End If
End If
End Sub
'Private Sub cmd学部セット_Click()
'
'End Sub
'学部コード変更→学科コードを変更する
Private Sub ComboBox1_Change()
'選んだINDEX
idx = Me.ComboBox1.ListIndex
'選択失敗→終了
If idx = -1 Then
Exit Sub
End If
'選択した学部Combの値を控えておく
Range("F21") = Me.ComboBox1.List(idx, 0)
Range("G21") = Me.ComboBox1.List(idx, 1)
Range("H21") = Me.ComboBox1.List(idx, 2)
'学科Combのクリアと項目の追加
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 '全て
Exit Sub
End If
'学科CODEを調べに行く
学科ODE = 0
MODE = 2
If func学部学科専門一覧(MODE, 学部CODE, 学科CODE) Then '成功
'項目の追加
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
End If
ComboBox2.ListIndex = 0
End Sub
'学科コード変更→専攻コードを変更する
Private Sub ComboBox2_Change()
'選んだINDEX
idx = Me.ComboBox2.ListIndex
'選択失敗→終了
If idx = -1 Then
Exit Sub
End If
'選択した学科Combの値を控えておく
Range("F24") = Me.ComboBox2.List(idx, 0)
Range("G24") = Me.ComboBox2.List(idx, 1)
Range("H24") = 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 '全て
Exit Sub
End If
'専攻CODEを調べに行く
MODE = 3
学部CODE = Range("G21")
学科CODE = Me.ComboBox2.List(idx, 1)
If func学部学科専門一覧(MODE, 学部CODE, 学科CODE) Then
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
End If
ComboBox3.ListIndex = 0
End Sub
Private Sub ComboBox3_Change()
'選んだINDEX
idx = Me.ComboBox3.ListIndex
'選択失敗→終了
If idx = -1 Then
Exit Sub
End If
'選択した学部Combの値を控えておく
Range("F27") = Me.ComboBox3.List(idx, 0)
Range("G27") = Me.ComboBox3.List(idx, 1)
Range("H27") = Me.ComboBox3.List(idx, 2)
End Sub
Private Sub CommandButton1_Click()
Dim all部 As type専攻
maxb = 0
For r = 6 To 18
If Cells(r, 2) > maxb Then
maxb = Cells(r, 2)
End If
Next r
maxk = 0
For r = 6 To 18
If Cells(r, 5) > maxk Then
maxk = Cells(r, 5)
End If
Next r
maxs = 0
For r = 6 To 18
If Cells(r, 8) > maxs Then
maxs = Cells(r, 8)
End If
Next r
MsgBox CStr(maxb) & "/" & CStr(maxk) & "/" & CStr(maxs)
ReDim Preserve all部(maxb, maxk, maxs)
For r = 6 To 18
End Sub
-----------------------------------------------------------------------------------------------
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
質問 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専攻
'-----------------------------------------------------------------
Function func学部学科専門一覧(MODE, from学部CODE, from学科CODE) As Boolean
from学部CODE = Trim(from学部CODE)
from学科CODE = Trim(from学科CODE)
Set sheet学部 = ThisWorkbook.Sheets("学部学科専攻new")
'MODE 1=学部一覧, 2=学科 ,3=専攻
学部学科専門一覧 = False
If MODE < 1 Or MODE > 3 Then
func学部学科専門一覧 = False
MsgBox "!"
Exit Function
End If
c学部番号 = sheet学部.Range("学部番号").Column
c学部CODE = sheet学部.Range("学部CODE").Column
c学部名 = sheet学部.Range("学部名").Column
c学科番号 = sheet学部.Range("学科番号").Column
c学科CODE = sheet学部.Range("学科CODE").Column
c学科名 = sheet学部.Range("学科名").Column
c専攻番号 = sheet学部.Range("専攻番号").Column
c専攻CODE = sheet学部.Range("専攻CODE").Column
c専攻名 = sheet学部.Range("専攻名").Column
c質問CODE = sheet学部.Range("質問CODE").Column
sheet学部.Activate
r開始 = sheet学部.Range("学部番号").Row + 1
r = r開始: chk = "A"
While chk <> ""
chk = sheet学部.Cells(r, c学部CODE) & sheet学部.Cells(r, c学科CODE) & sheet学部.Cells(r, c専攻CODE)
r = r + 1
Wend
r終了 = r - 2
If MODE = 1 Then
GoSub 学部表
' aaa = ""
' For i = 0 To UBound(PUB_aryコンボ)
' aaa = aaa & Str(i) & " " & PUB_aryコンボ(i).番号 & " " & PUB_aryコンボ(i).CODE & " " & PUB_aryコンボ(i).名称 & vbCrLf
' Next i
' MsgBox aaa
End If
If MODE = 2 Then
GoSub 学科表
' aaa = ""
' For i = 0 To UBound(PUB_aryコンボ)
' aaa = aaa & Str(i) & " " & PUB_aryコンボ(i).番号 & " " & PUB_aryコンボ(i).CODE & " " & PUB_aryコンボ(i).名称 & vbCrLf
' Next i
' MsgBox aaa
End If
If MODE = 3 Then
GoSub 専攻表
' aaa = ""
' For i = 0 To UBound(PUB_aryコンボ)
' aaa = aaa & Str(i) & " " & PUB_aryコンボ(i).番号 & " " & PUB_aryコンボ(i).CODE & " " & PUB_aryコンボ(i).名称 & vbCrLf
' Next i
' MsgBox aaa
End If
func学部学科専門一覧 = True
Exit Function
'==================================================
学部表:
'==================================================
my学部CODE = ""
i = 0
For r = r開始 To r終了
If sheet学部.Cells(r, c学部CODE) <> my学部CODE Then
ReDim Preserve PUB_aryコンボ(i)
PUB_aryコンボ(i).番号 = sheet学部.Cells(r, c学部番号)
PUB_aryコンボ(i).CODE = sheet学部.Cells(r, c学部CODE)
PUB_aryコンボ(i).名称 = sheet学部.Cells(r, c学部名)
PUB_aryコンボ(i).質問 = sheet学部.Cells(r, c質問CODE)
my学部CODE = PUB_aryコンボ(i).CODE
i = i + 1
End If
Next r
Return
'==================================================
学科表:
'==================================================
my学科CODE = ""
i = 0
For r = r開始 To r終了
If sheet学部.Cells(r, c学部CODE) = from学部CODE Then '指定学部コードなら作業
If sheet学部.Cells(r, c学科CODE) <> my学科CODE Then
ReDim Preserve PUB_aryコンボ(i)
PUB_aryコンボ(i).番号 = sheet学部.Cells(r, c学科番号)
PUB_aryコンボ(i).CODE = sheet学部.Cells(r, c学科CODE)
PUB_aryコンボ(i).名称 = sheet学部.Cells(r, c学科名)
PUB_aryコンボ(i).質問 = sheet学部.Cells(r, c質問CODE)
my学科CODE = PUB_aryコンボ(i).CODE
i = i + 1
End If
End If
Next r
Return
'==================================================
専攻表:
'==================================================
i = 0
For r = r開始 To r終了
If (sheet学部.Cells(r, c学部CODE) = from学部CODE) And _
(Str(sheet学部.Cells(r, c学科CODE)) = Str(from学科CODE)) Then
ReDim Preserve PUB_aryコンボ(i)
PUB_aryコンボ(i).番号 = sheet学部.Cells(r, c専攻番号)
PUB_aryコンボ(i).CODE = sheet学部.Cells(r, c専攻CODE)
PUB_aryコンボ(i).名称 = sheet学部.Cells(r, c専攻名)
PUB_aryコンボ(i).質問 = sheet学部.Cells(r, c質問CODE)
i = i + 1
End If
Next r
Return
End Function