名簿作りマクロ(4)
名簿作りマクロ メインコードの組立
過去記事
作成するプロシージャ
まず、転記処理の流れを整理しておこう。
- 【プロシージャ1a】「戦法別」シートへの転記開始用プロシージャ
- 【プロシージャ1b】「都道府県別」シートへの転記開始用プロシージャ
- 【プロシージャ2】データ転記メイン処理用プロシージャ
- 【プロシージャ3】Racer型変数へのデータセット用プロシージャ
- 【プロシージャ4-1a】「戦法別」シートへのデータ1件分転記用プロシージャ
- 【プロシージャ4-1b】「都道府県別」シートへのデータ1件分転記用プロシージャ
- 【プロシージャ4-2a】「戦法別」シートのデータ並べ替え用プロシージャ
- 【プロシージャ4-2b】「都道府県別」シートのデータ並べ替え用プロシージャ
処理の手順としては、
- プロシージャ1で転記先シートの準備をして、プロシージャ2を呼び出す
- プロシージャ2では、まずプロシージャ3を呼び出してGambleRacerクラスのインスタンス用の基礎データを準備する
- プロシージャ2に戻ってGambleRacerクラスのインスタンスにデータをセット
- プロシージャ4-1を呼び出してデータを転記先シートに追記
- 全ての転記が終わったら、プロシージャ4-1を呼び出してデータを並べ替える
といったものになる。
【プロシージャ1】
転記先シートへの転記開始用プロシージャ
転記先シートが2つあるので、2種類のプロシージャを作る。
リスト1a 「戦法別」シートへの転記開始用プロシージャ
Public Sub writeStyleSheet() Set styleSh = ThisWorkbook.Worksheets("戦法別") '……(1)' With styleSh '……(2)' .Cells.Borders.LineStyle = xlNone '……(3)' .Range("A" & STYLE_START_ROW).CurrentRegion.Offset(1, 0).ClearContents '……(4)' End With Call createTable(PROCESS_STYLE) '……(5)' With styleSh.Range("A" & STYLE_START_ROW).CurrentRegion.Offset(0, STYLE_START_ROW) .Resize(.Rows.Count, .Columns.Count - 3) _ .Borders.LineStyle = xlContinuous '……(6)' End With End Sub
(1)の
Set styleSh = ThisWorkbook.Worksheets("戦法別")
で、「戦法別」シートを変数にセット。(2)でWithしているので、以下、(3)、(4)は、「戦法別」シートへの処理になる。
(3)の
.Cells.Borders.LineStyle = xlNone
でセルの罫線を全消去し、
(4)の
.Range("A" & STYLE_START_ROW).CurrentRegion.Offset(1, 0).ClearContents
では、見出し以外のセルの値を消去している。
見出しだけを残すには、一旦表全体のセル範囲を獲得してから1つ下にずらせばよいのだから、CurrentRegionプロパティで表全体を取得してから、OffSetプロパティで1つ下にずらした範囲を取得している。
このやり方だと、本来取得したい範囲プラス1行分の範囲を取得してしまうことになるので、本当はResizeプロパティでタテ(行)方向に1つサイズを縮めないといけないんだが、1行余分にClearContentsしてもまるで困らないのでResizeプロパティは使わない。
(5)では、後述のcreateTableプロシージャを呼んで、転記処理を行う。
(5)の処理が終わって、このプロシージャに処理が帰ってきたら、転記と並べ替えは終わっているので、後は(6)の
With styleSh.Range("A" & STYLE_START_ROW).CurrentRegion.Offset(0, STYLE_START_ROW) .Resize(.Rows.Count, .Columns.Count - 3) _ .Borders.LineStyle = xlContinuous '……(6) End With
で、できあがった表に格子罫線を施す。
ただし、「戦法別」シートにできあがった表のA~C列は、並べ替えのキーにするために必要なだけなので、A~C列には罫線を施さない。
そのために、Resizeプロパティでヨコ(列)方向に3だけ範囲を縮めている。
ま、別にA~C列に罫線があったって構わないんだが、Resizeプロパティの練習ということで……。
リスト1b 「都道府県別」シートへの転記開始用プロシージャ
Public Sub writePrefSheet() Set prefSh = ThisWorkbook.Worksheets("都道府県別") With prefSh .Cells.Borders.LineStyle = xlNone .Range("A" & PREF_START_ROW).CurrentRegion.Offset(1, 0).ClearContents End With Call createTable(PROCESS_PREF) With prefSh.Range("A" & PREF_START_ROW).CurrentRegion.Offset(0, PREF_START_ROW) .Resize(.Rows.Count, .Columns.Count - 3).Borders.LineStyle = xlContinuous End With End Sub
転記先が「都道府県別」シートに変わっただけで、やっていることはリスト1aとほぼ同じなので、説明は省略。
【プロシージャ2】
データ転記メイン処理用プロシージャ
リスト2 データ転記メイン処理用プロシージャ
Public Sub createTable(ByVal processNum As Integer) Set orgSh = ThisWorkbook.Worksheets("選手データ") '……(1)' Dim lastRow As Integer '……(2)' lastRow = orgSh.Cells(Rows.Count, 1).End(xlUp).Row Dim i As Integer For i = ORG_START_ROW To lastRow '……(3)' Call setBasicData(i) '……(4)' Set gblRacer = New GambleRacer '……(5)' With gblRacer '……(6)' .setData racerData '……(7)' If .isEliminated = True Then '……(8)' GoTo myJump '……(9)' End If Set cdGetter = New CodeGetter '……(10)' cdGetter.getCode .belongsTo, .rcStyle '……(11)' .setCode cdGetter.prefNum, cdGetter.styleNum '……(12)' End With If processNum = PROCESS_STYLE Then '……(13)' Call writeDataToStyleSheet '……(14)' End If If processNum = PROCESS_PREF Then Call writeDataToPrefSheet End If myJump: '……(15)' Set gblRacer = Nothing '……(16)' Set cdGetter = Nothing Next If processNum = PROCESS_STYLE Then '……(17)' Call sortTableByStyle End If If processNum = PROCESS_PREF Then Call sortTableByPref End If End Sub
(1)の
Set orgSh = ThisWorkbook.Worksheets("選手データ")
では、変数に「選手データ」シートをセット。
(2)からの2行、
Dim lastRow As Integer lastRow = orgSh.Cells(Rows.Count, 1).End(xlUp).Row
は、おなじみの最終行取得。
(3)では、
For i = ORG_START_ROW To lastRow
このように、Forループの開始値と終了値を定めている。データ開始行から最終行までループ処理をするということ。
(4)で、変数i(「選手データ」シートの現在処理中の行番号)を引数として渡してsetBasicDataプロシージャを呼ぶ。最初に書いた処理の手順の2番目に挙げた過程にあたる。
(5)、(6)の
Set gblRacer = New GambleRacer With gblRacer
は、GambleRacerクラスのインスタンスを生成し、即With。ここからEnd Withまでの間はGambleRacerクラスのインスタンスに対する処理ということになる。
※GambleRacerクラスについてはコチラを参照
(7)でsetDataメソッドを用いてデータをセット。引数としてRacer型の変数を渡している。
(8)の
If .isEliminated = True Then
では、GambleRacerクラスのインスタンスのisEliminatedプロパティの値により条件分岐する。
isEliminatedがTrueのときは、転記を行わずに次のループに進む。
そのために、Ifブロックの中に、(9)、すなわち、
GoTo myJump
と書いて、途中の処理をすっ飛ばして(15)のmyJumpラベルに飛ぶようにした。こうすることで、転記処理を行わずに次のループに進ませることができる。
ただ、見ての通り、
For ・・・・・・・・ ・・・・・・・・ ・・・・・・・・ myJump: Next
こんなふうに、For~Nextブロックのインデントが狂ってしまうのがちょっと残念。
(10)~(12)の3行、
Set cdGetter = New CodeGetter '……(10)' cdGetter.getCode .belongsTo, .rcStyle '……(11)' .setCode cdGetter.prefNum, cdGetter.styleNum
では、まず(10)でCodeGetterクラスのインスタンスをセット。
※CodeGetterクラスについてはコチラを参照
(11)でCodeGetterクラスのgetCodeメソッドを用いて都道府県No.、戦法No.を取得し、
(12)でGambleRacerクラスのsetCodeメソッドを用いて都道府県No.、戦法No.をGambleRacerクラスのインスタンスにセットしている。
(13)の
If processNum = PROCESS_STYLE Then
では、このプロシージャが呼ばれたときの引数に応じて、データ書き込み用プロシージャ2つのうちどちらを呼ぶかを判定している。
ちなみに、(14)の
Call writeDataToStyleSheet
は、引数processNumがPROCESS_STYLEだった場合に実行される。
ここまでで1件分のデータの転記が終わる。
(16)からの2行、
Set gblRacer = Nothing Set cdGetter = Nothing
でインスタンス用の変数を解放。
Forループが終了すると、後は(17)からの6行で、転記先シートの表のデータを並べかえておしまい。
【プロシージャ3】
Racer型変数へのデータセット用プロシージャ
リスト3 Racer型変数へのデータセット用プロシージャ
Private Sub setBasicData(ByVal i As Integer) racerData.isEliminated = False With orgSh racerData.rcName = .Cells(i, orgCol.rcName).Value racerData.rcPhonetic = .Cells(i, orgCol.rcPhonetic).Value racerData.belongsTo = .Cells(i, orgCol.belongsTo).Value racerData.graduateTerm = .Cells(i, orgCol.graduateTerm).Value racerData.rcGrade = .Cells(i, orgCol.rcGrade).Value racerData.rcClass = .Cells(i, orgCol.rcClass).Value racerData.rcStyle = .Cells(i, orgCol.rcStyle).Value If .Cells(i, orgCol.isEliminated).Value = 1 Then '……(1)' racerData.isEliminated = True End If End With End Sub
「選手データ」シートの表から、Racer型変数に値を渡しているだけ。唯一(1)のところは、
値が1だったらisEliminatedをTrueにする
というふうにしている。
【プロシージャ4-1】
データ1件分転記用プロシージャ
こちらも、転記先シートが2つあるので、2種類のプロシージャを作る。
リスト4-1a 「戦法別」シートへの1件分データ転記用プロシージャ
Private Sub writeDataToStyleSheet() Dim objRow As Integer objRow = styleSh.Cells(Rows.Count, 1).End(xlUp).Row + 1 With styleSh .Cells(objRow, styleCol.prefNum).Value = gblRacer.prefNum .Cells(objRow, styleCol.styleNum).Value = gblRacer.styleNum .Cells(objRow, styleCol.rcPhonetic).Value = gblRacer.rcPhonetic .Cells(objRow, styleCol.rcStyle).Value = gblRacer.rcStyle .Cells(objRow, styleCol.rcName).Value = gblRacer.rcName .Cells(objRow, styleCol.graduateTerm).Value = gblRacer.graduateTerm .Cells(objRow, styleCol.rcGrade).Value = gblRacer.rcGrade .Cells(objRow, styleCol.rcClass).Value = gblRacer.rcClass .Cells(objRow, styleCol.belongsTo).Value = gblRacer.belongsTo End With End Sub
リスト4-1b 「都道府県別」シートへの1件分データ転記用プロシージャ
Private Sub writeDataToPrefSheet() Dim objRow As Integer objRow = prefSh.Cells(Rows.Count, 1).End(xlUp).Row + 1 With prefSh .Cells(objRow, prefCol.prefNum).Value = gblRacer.prefNum .Cells(objRow, prefCol.styleNum).Value = gblRacer.styleNum .Cells(objRow, prefCol.rcPhonetic).Value = gblRacer.rcPhonetic .Cells(objRow, prefCol.belongsTo).Value = gblRacer.belongsTo .Cells(objRow, prefCol.rcName).Value = gblRacer.rcName .Cells(objRow, prefCol.graduateTerm).Value = gblRacer.graduateTerm .Cells(objRow, prefCol.rcGrade).Value = gblRacer.rcGrade .Cells(objRow, prefCol.rcClass).Value = gblRacer.rcClass .Cells(objRow, prefCol.rcStyle).Value = gblRacer.rcStyle End With End Sub
リスト4-1a、リスト4-1bともに、GambleRaceクラスのインスタンスが持っている値をそれぞれの列に書き込んでいるだけなので、何ら難しいポイントはないと思う。
Enumの識別子(って言うのかな? 今回の例で言うと「prefCol」とか「styleCol」にあたるやつ)を変数か何かで切り替えられたら便利なんだけど、そうする方法が見当たらなかったので、なんか同じようなコードを2回も書いているというのがちょっと気にくわない。
【プロシージャ4-2】
シートの並べ替え用プロシージャ
リスト4-2a 「戦法別」シートの並べ替え用プロシージャ
Private Sub sortTableByStyle() Dim objRange As Range Set objRange = styleSh.Range("A" & STYLE_START_ROW).CurrentRegion With styleSh objRange.Sort Key1:=.Cells(STYLE_START_ROW, styleCol.rcPhonetic), _ Order1:=xlAscending, _ Header:=xlYes objRange.Sort Key1:=.Cells(STYLE_START_ROW, styleCol.styleNum), _ Order1:=xlAscending, _ Header:=xlYes, _ Key2:=.Cells(STYLE_START_ROW, styleCol.prefNum), _ order2:=xlAscending, _ key3:=.Cells(STYLE_START_ROW, styleCol.graduateTerm), _ order3:=xlAscending End With End Sub
リスト4-2a 「戦法別」シートの並べ替え用プロシージャ
Private Sub sortTableByPref() Dim objRange As Range Set objRange = prefSh.Range("A" & PREF_START_ROW).CurrentRegion With prefSh objRange.Sort Key1:=.Cells(PREF_START_ROW, prefCol.rcPhonetic), _ Order1:=xlAscending, _ Header:=xlYes objRange.Sort Key1:=.Cells(PREF_START_ROW, prefCol.prefNum), _ Order1:=xlAscending, _ Header:=xlYes, _ Key2:=.Cells(PREF_START_ROW, prefCol.graduateTerm), _ order2:=xlAscending, _ key3:=.Cells(PREF_START_ROW, prefCol.styleNum), _ order3:=xlAscending End With End Sub
コチラも、できあがった表のデータを並べ替えているだけなので、何も説明はいらないと思う。
実行結果
準備
「選手データ」シートに、
こんな風にデータを用意する。
※isEliminatedが「1」になっていることに深い意味はありませんよ。
それぞれの転記先シートにコマンドボタンを置いて、
- 「戦法別」シートの方にはwriteStyleSheetプロシージャ
- 「都道府県別」シートの方にはwritePrefSheetプロシージャ
を登録しておく。
実行
ボタンを押すと、
ほれ、いづれも希望通りに転記できた。
んでも、せっかくクラスモジュールを使っているんだからもっとうまい書き方をしないといけないなあ。
どうもいわゆるDRYの原則が守れていない気がする。