名簿作りマクロ(4)

名簿作りマクロ メインコードの組立

過去記事

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

作成するプロシージャ

まず、転記処理の流れを整理しておこう。

処理の手順としては、

  1. プロシージャ1で転記先シートの準備をして、プロシージャ2を呼び出す
  2. プロシージャ2では、まずプロシージャ3を呼び出してGambleRacerクラスのインスタンス用の基礎データを準備する
  3. プロシージャ2に戻ってGambleRacerクラスのインスタンスにデータをセット
  4. プロシージャ4-1を呼び出してデータを転記先シートに追記
  5. 全ての転記が終わったら、プロシージャ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

コチラも、できあがった表のデータを並べ替えているだけなので、何も説明はいらないと思う。

実行結果

準備

「選手データ」シートに、

f:id:akashi_keirin:20170415131005j:plain

こんな風にデータを用意する。
※isEliminatedが「1」になっていることに深い意味はありませんよ。

それぞれの転記先シートにコマンドボタンを置いて、

を登録しておく。

実行

ボタンを押すと、

f:id:akashi_keirin:20170415131015j:plain

f:id:akashi_keirin:20170415131024j:plain

ほれ、いづれも希望通りに転記できた。

んでも、せっかくクラスモジュールを使っているんだからもっとうまい書き方をしないといけないなあ。

どうもいわゆるDRYの原則が守れていない気がする。