読者です 読者をやめる 読者になる 読者になる

配列関係の覚書

Split関数(VBA)など配列回りの覚書

Split関数

Split関数は、


Split(文字列, デリミタ)

とすれば、第1引数の文字列を、第2引数のデリミタで区切った文字列を配列にして返してくれるとっても便利な関数。

んで、めちゃくちゃ基本的なことなんだが、

配列であるからには添え字は0スタート

なんである。

ところが、素人の悲しさ。こういう当たり前のことがしばしばあやふやになるw

というわけで、覚書として残しておこう。

Split関数の使用例

リスト1
Public Sub testHage1()
  Dim hageArray As Variant    '……(1)
  hageArray = Split("ち~んw,ウホッw,ウマーw,アヒャw", ",")    '……(2)
  Debug.Print LBound(hageArray)    '……(3)
  Debug.Print UBound(hageArray)    '……(4)
  Dim i As Integer
  For i = LBound(hageArray) To UBound(hageArray)    '……(5)
    Debug.Print hageArray(i)
  Next
End Sub

(1)の

Dim hageArray As Variant

は、Split関数の返り値(配列)を受け取るための変数。配列の要素数が分からないのでVariant型にしている。

(2)の

hageArray = Split("ち~んw,ウホッw,ウマーw,アヒャw", ",")

で、Splitを実行。返り値を変数hageArray(なんちゅう名前や……)にセットしている。

(3)、(4)の

Debug.Print LBound(hageArray)
Debug.Print UBound(hageArray)

で、LBound及びUBound関数を使って最小の添え字と最大の添え字をイミディエイトに表示するようにしている。

(5)の

For i = LBound(hageArray) To UBound(hageArray)
  Debug.Print hageArray(i)
Next

では、Forループを使って配列hageArrayの全ての要素をイミディエイトに表示するようにしている。

実行結果

f:id:akashi_keirin:20170423110156j:plain

この通り、配列の添え字は「0」~「3」ですね。当たり前だけど。

Variant型の使用を避ける

Variant型が嫌いです。なんか、すっげえ雑な対応のような気がするのです。

そこで、考えた。

Split関数の返り値をUBoundに突っ込んでその数でReDimすりゃいいんじゃね?

と。

で、やってみた。

スト2
Public Sub testHage2()
  Dim hageArray() As String    '……(1)
  ReDim hageArray(UBound(Split("ち~んw,ウホッw,ウマーw,アヒャw", ",")))    '……(2)
  hageArray() = Split("ち~んw,ウホッw,ウマーw,アヒャw", ",")    '……(3)
  Debug.Print LBound(hageArray)
  Debug.Print UBound(hageArray)
  Dim i As Integer
  For i = LBound(hageArray) To UBound(hageArray)
    Debug.Print hageArray(i)
  Next
End Sub

(1)では、リスト1と異なり、

Dim hageArray() As String

String型の配列として正々堂々と(?)変数を宣言。

(2)では、

ReDim hageArray(UBound(Split("ち~んw,ウホッw,ウマーw,アヒャw", ",")))

Split関数の返り値をUBound関数の引数にぶち込んで配列変数hageArray()をReDim。

んで、(3)の

hageArray() = Split("ち~んw,ウホッw,ウマーw,アヒャw", ",")

で配列hageArrayに要素をぶち込んでいる。

実行結果

f:id:akashi_keirin:20170423110156j:plain

ほれ、同じ結果になった。

・・・・・・

でもねえ・・・・・・。

なんて無駄なコードなんだ!!!!!!!!

まとめと感想

まとめ
  • Split関数でできた配列の添え字は、「0」~「要素数-1」です
  • LBound関数の返り値は、配列の添え字の最小値です
  • UBound関数の返り値は、配列の添え字の最大値です
  • 配列用の変数をReDimするときは、添え字の最大値で行いましょう
感想

まだまだ分かっていないことが多いなあ。

@akashi_keirin on Twitter

Thunderbirdメール自動作成マクロで複数アドレス指定に対応するのは簡単だった

Thunderbirdで複数の宛先を指定するのは簡単だった

Shell関数でThunderbirdのメールを作成する

このときにも紹介したが、VBAThunderbirdのメールを作成するには、次のようなコードを書けば良い。

リスト1
Shell "Thunderbird実行ファイルのフルパス"  -compose _
to=送信先メールアドレス, _
cc=CCアドレス, _
subject=メール件名, _
body=本文文字列, _
attachment='添付ファイルフルパス'

普通、複数の宛先を設定するときには「,」(半角カンマ)でアドレスを区切ったら良さそうなものなんだが(実際、LotusNotesの場合はそれでうまく行く)、Thunderbirdだとうまく行かない。

実験

スト2
Public Sub testHoge()
  Dim tbPath As String
  tbPath = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"
  tbPath = """" & tbPath & """ -compose """
  Dim mailTo As String
  mailTo = "hoge@foo.bar.jp,fuga@foo.bar.jp"    '……(1)
  Dim mailSubj As String
  mailSubj = "ち~んw"
  Dim mailBody As String
  mailBody = "ち~んw"
  Shell tbPath & _
    "to=" & mailTo & "," & _
    "subject=""" & mailSubj & """," & _
    "body=""" & mailBody & """"
End Sub

たとえば、(1)のように送信先アドレスに半角カンマ区切りで複数のアドレスを与えたつもりでも、これを実行すると、

f:id:akashi_keirin:20170423074123j:plain

こうなる。一つ目のアドレスにしか反応しとらん。

対応

あれこれとggっていて、このページにたどりついた。

カンマではなく、セミコロン ";" で連結するのでは?

ということだったので、そうしてみた。

リスト3
Public Sub testHoge()
  Dim tbPath As String
  tbPath = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"
  tbPath = """" & tbPath & """ -compose """
  Dim mailTo As String
  mailTo = "hoge@foo.bar.jp;fuga@foo.bar.jp"    '……(1)
  Dim mailSubj As String
  mailSubj = "ち~んw"
  Dim mailBody As String
  mailBody = "ち~んw"
  Shell tbPath & _
    "to=" & mailTo & "," & _
    "subject=""" & mailSubj & """," & _
    "body=""" & mailBody & """"
End Sub

変えたのは(1)のところのみ。「,」(半角カンマ)を「;」(半角セミコロン)に変えただけ。

実行結果

コードを実行してみると、

f:id:akashi_keirin:20170423074127j:plain

おおっ! ちゃんと2箇所あてのメールになっとる!

感想

めちゃくちゃ簡単でした。

幸せというものは、案外足下に転がっているものなんだなあ。。。(『青い鳥』風)

これで、このときThunderbirdメール作成メソッドで、メールアドレスを渡す部分

Shell thunderbirdPath & _
    "to=" & mailTo_ & "," & _
    "cc=" & CC_ & "," & _
    "bcc=" & BCC_ & "," & _
    "subject=""" & mailSubject_ & """," & _
    "body=""" & strBody & """," & _
    "attachment=""" & strAttFile & """"
End Sub

を、

Shell thunderbirdPath & _
    "to=" & Replace(mailTo_, ",", ";") & "," & _
    "cc=" & Replace(CC_, ",", ";") & "," & _
    "bcc=" & Replace(BCC_, ",", ";") & "," & _
    "subject=""" & mailSubject_ & """," & _
    "body=""" & strBody & """," & _
    "attachment=""" & strAttFile & """"
End Sub

に変えるだけで複数アドレス指定に対応できるなあ。

@akashi_keirin on Twitter

VBAで名前の定義をするといろいろ楽

セル範囲の名前の定義をVBAでやったら便利

転記するごとにセル範囲を定義し直す

このときみたいなデータ転記系の処理をした場合、ワークシート関数のCOUNTIFなんかを使って種別ごとの数を勘定したい、ということがよくある。

しかしながら、転記件数が変化する場合、COUNTIFの第1引数(範囲)が変化することになる。

だからといって、毎回転記処理が終わってから手動でCOUNTIFをセットするというのもマヌケな話。

そこで、

抽出するごとにCOUNTIFの第1引数になるセル範囲に名前を定義すりゃいいじゃん!

と考えた。

方針

手順は次の通り。

  1. まず、対象となるセル範囲に「StyleRangeForCount」と名前を付けておく
  2. VBAで、一旦「StyleRangeForCount」と名付けられたセル範囲のNameプロパティをDeleteする
  3. 新たにCOUNTIFの第1引数にしたいセル範囲を取得する
  4. 3.で取得したセル範囲のNameプロパティに「StyleRangeForCount」という名前をセットする

このようにしておいて、COUNTIFの第1引数を「StyleRangeForCount」にしておけば、転記結果が変化してもCOUNTIFの第1引数が変化に追随してくれるはずだ。

リスト1
Public Sub renameRange()
  Set styleSh = ThisWorkbook.Worksheets("戦法別")
  Dim objRange As Range
  Dim lastRow As Integer
  Range("StyleRangeForCount").name.Delete    '……(1)
  With styleSh
    lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    Set objRange = Range(.Range("D3"), _
                         .Range("D" & lastRow))    '……(2)
  End With
  objRange.name = "StyleRangeForCount"    '……(3)
End Sub

実際には、もう少し複雑なコードを書いたんだが、説明のために単純化したコードを載っけている。

まず、(1)の

Range("StyleRangeForCount").Name.Delete

で、もともとの「StyleRangeForCount」という名前をDelete。

次に、(2)の

Set objRange = Range(.Range("D3"), .Range("D" & lastRow))

で、新たにできたCOUNTIFの第1引数にすべき範囲を変数objRangeにセット。

最後に、(3)の

objRange.name = "StyleRangeForCount"

で新たにできたCOUNTIFの第1引数にすべき範囲に「StyleRangeForCount」と名前を付けている。

実行

f:id:akashi_keirin:20170422215310j:plain

ちょっと分かりにくいかも知れないが、最初は、D3~D37のセル範囲に「StyleRangeForCount」という名前が定義されている。

f:id:akashi_keirin:20170422215316j:plain

転記元データをちょっといじくって、失格選手(w)を増やし、再度転記処理を行ってみる。

f:id:akashi_keirin:20170422215327j:plain

当然、転記される件数が減るので、こんな状態になる。依然、「StyleRangeForCount」と名付けられたセル範囲はD3~D37のまま。

ここで、リスト1を実行。

f:id:akashi_keirin:20170422215344j:plain

セル範囲D3~D37から名前がぬぐい去られていることがお分かりだろうか。

んで、セルの選択範囲をD3~D27に変えると、

f:id:akashi_keirin:20170422215406j:plain

ほれ、「StyleRangeForCount」という名前が定義されている。

f:id:akashi_keirin:20170422215417j:plain

こんなふうに、COUNTIFの第1引数を「StyleRangeForCount」にしておくと、

失格者を増やす前

f:id:akashi_keirin:20170422215424j:plain

失格者を増やした後

f:id:akashi_keirin:20170422215433j:plain

と、COUNTIFの結果が転記結果に追随していることが分かる。

感想

手作業で名前の定義や編集・削除を行うのはかなりメンドクサイんだけど、VBAでやると簡単・便利だと思いました。

@akashi_keirin on Twitter

ActiveWindowプロパティでちょっとハマる……

ActiveWindowプロパティの怪

Excel2010でのエラー

職場のPCはOffice2010なんだが、妙なエラーが出た。

ThisWorkbookモジュールに仕込んだWorkbook_Openイベントマクロでの話。

データを集約するマクロを作っていて、データ集約が終わったら、マクロを仕込んだブックから、不要なシートを削除して新しいブックとして保存するようにしていると思ってください。

データ集約用本体のブックと、新たにできあがった集約データ入りのブックは、シートの数が異なることになるので、ブックオープン時に処理を切り替えるようにした。

リスト1
Private Sub Workbook_Open()
  If ThisWorkbook.Worksheets.Count = 2 Then
    ActiveWindow.DisplayHeadings = True    '……(1)
    Exit Sub
  End If
  '通常の処理
       ・
       ・
       ・
End Sub

たとえばこんな感じ。

オープン時にシートの数が「2」だということは、データ集約済みのブックだということになるので、(1)の処理をしてプロシージャを抜けるようにしたわけです。

で、これを職場のPCで、

他のブックが開いている状態で

実行すると、

オブジェクト変数または With ブロック変数が設定されていません。

というエラーが出た。

単独で開くときにはエラーにならないのに。

対応

デバッグ」をクリックしてVBE上で確認すると、リスト1の(1)のところ、

ActiveWindow.DisplayHeadings = True

がハイライトされている。

んで、「ActiveWindow」が「Nothing」になっているらしい。

わけわからん。

で、リスト1の(1)を

Application.Windows(1).DisplayHeadings = True

にしたら直った。

分からないこと

  • なぜ「ActiveWindow」が「Nothing」になってしまうのか。「Workbook_Open」が実行されているということは、そのブックが「ActiveWindow」になっているはずなのに。
  • しかも、この現象は2013では再現できなかった。

納得いかないぜーーー!

@akashi_keirin on Twitter

データ抽出用クラスを作る

データ抽出用のクラス

AdvancedFilterメソッドを気軽に使う

あんまり役に立たないと思うけど、ちょっと作ってみた。

準備として、

f:id:akashi_keirin:20170416102826j:plain

データ抽出元のシートを用意。

f:id:akashi_keirin:20170416102837j:plain

こんなふうに抽出条件設定用の表を作り、

f:id:akashi_keirin:20170416102833j:plain

セル範囲に名前を付けておく。

ちなみに、抽出条件は、ヨコの並びがAND、タテの並びがOR条件。

この画像だと、「戦法が先捲か捲先で、80期未満の選手」を抽出することになる。

競輪を例にしているだけに、タテだのヨコだの言ったらややこしいな。

f:id:akashi_keirin:20170416102843j:plain

抽出先のデータラベルもこのように準備。同じく、名前を付けておく。

クラスモジュールのコード

クラスモジュールを挿入して、オブジェクト名は「DataExtractor」にした。

リスト1-1 フィールド・アクセサ部分
Option Explicit
'フィールド
Private dataSource_ As Range    '……(1)
Private rangeOfCriteria_ As Range
Private copyTo_ As Range
'アクセサ
Public Property Get extractedRange() As Range    '……(2)
  Set extractedRange = copyTo_.CurrentRegion
End Property
Public Property Get dataCount() As Long
  dataCount = extractedRange.Rows.Count - 1
End Property

珍しく、仮変数とPropertyプロシージャの名前(?)が一致していない。

(1)からの3行、

Private dataSource_ As Range
Private rangeOfCriteria_ As Range
Private copyTo_ As Range

は、AdvancedFilterメソッドの実行に必要なオブジェクトや引数。

従って、メソッド実行時に引数として渡せば良いし、後で取得することもないだろうから、変数のみにした。

逆に、(2)からの6行、

Public Property Get extractedRange() As Range
  Set extractedRange = copyTo_.CurrentRegion    '……(a)
End Property
Public Property Get dataCount() As Long
  dataCount = extractedRange.Rows.Count - 1    '……(b)
End Property

は、抽出実行後に自ずと決まるものなので、仮変数は必要ないと思った。

(a)は、抽出先のセルのCurrentRegionプロパティを取得することで、抽出されたデータ範囲をセットしている。

(b)は、(a)で決まった抽出データの範囲の行数を取得し、1を引くことで、抽出されたデータの件数をセットしている。

リスト1-2 メソッド部分
Public Sub extractData(ByVal dataSource As Range, _
                       ByVal rangeOfCriteria As Range, _
                       ByVal copyTo As Range)    '……(1)
  Set dataSource_ = dataSource    '……(2)
  Set rangeOfCriteria_ = rangeOfCriteria
  Set copyTo_ = copyTo
  copyTo_.CurrentRegion.Offset(1, 0).Clear    '……(3)
  dataSource_.AdvancedFilter _
                Action:=xlFilterCopy, _
                criteriaRange:=rangeOfCriteria_, _
                CopytoRange:=copyTo_    '……(4)
  extractedRange _
    .Offset(1, 0) _
    .Borders.LineStyle = xlNone    '……(5)
End Sub

メソッドはとりあえず一つだけ。

(1)の

Public Sub extractData(ByVal dataSource As Range, _
                       ByVal rangeOfCriteria As Range, _
                       ByVal copyTo As Range)

でお分かりのように、3つの引数を受け取って実行する。

  • 第1引数は抽出元のデータ範囲
  • 第2引数は抽出条件のデータ範囲
  • 第3引数は抽出先のデータラベルの範囲

それぞれの引数の役割は以上の通り。

(2)からの3行、

Set dataSource_ = dataSource
Set rangeOfCriteria_ = rangeOfCriteria
Set copyTo_ = copyTo

は、引数をクラス内の仮変数に代入している。

(3)の

copyTo_.CurrentRegion.Offset(1, 0).Clear

によって、一旦抽出先の表をクリア。データラベルを消さないようにOffsetしている。

(4)の

dataSource_.AdvancedFilter _
              Action:=xlFilterCopy, _
              CriteriaRange:=rangeOfCriteria_, _
              CopytoRange:=copyTo_

これがAdvancedFilterメソッドの本体。これで抽出が行われる。

あと、(5)の

extractedRange _
    .Offset(1, 0) _
    .Borders.LineStyle = xlNone

は、抽出されたデータ範囲の罫線消去。

別になくても困らないとは思うけど、罫線が残ったままだとブサイクなのでこうした。

DataExtractorクラスを使う

宣言セクションにEnumを追加する。

リスト2-1 標準モジュールの宣言セクション
Public Enum extractCol
  rcName = 1
  rcPhonetic
  belongsTo
  graduateTerm
  rcGrade
  rcClass
  rcStyle
  isEliminated
End Enum
リスト2-2 実行用コード
Public Sub test03()
  With ThisWorkbook
    Set orgSh = ThisWorkbook.Worksheets("選手データ")
    Set extractSh = ThisWorkbook.Worksheets("抽出")
  End With
  Dim dtExtractor As DataExtractor    '……(1)
  Set dtExtractor = New DataExtractor
  With dtExtractor    '……(2)
    .extractData orgSh.Range("A1").CurrentRegion, _
                 Range("RangeOfCriteria"), _
                 Range("CopyToRange")    '……(3)
    MsgBox "全 " & .dataCount & " 名、抽出完了。", vbInformation
    Dim str As String
    str = "抽出したのは、" & vbCrLf & vbCrLf
    If .dataCount = 0 Then
      MsgBox str & "……て、誰もおらんやないかーーーーい!", vbCritical
      Exit Sub
    End If
    Dim i As Integer
    Dim flg As Boolean
    For i = 1 To .dataCount
      If i > 5 Then
        flg = True
        Exit For
      End If
      str = str & extractSh.Cells(i + 1, extractCol.rcName).Value _
            & "選手、" & vbCrLf
    Next
  End With
  str = Left(str, Len(str) - 1)
  If flg = True Then
    str = str & vbCrLf & "……て、人数多すぎるんじゃぼけーーー!" & _
            vbCrLf & "やってられっか!"
    MsgBox str
    Exit Sub
  End If
  MsgBox str & "です。"
End Sub

(1)からの2行、

Dim dtExtractor As DataExtractor
Set dtExtractor = New DataExtractor

は、インスタンス用の変数の宣言とNewによるインスタンス化。

(2)の

With dtExtractor

は、おなじみの記述。

(3)で抽出実行。セル範囲に名前を付けているので、簡単に指定できる。

以下のコードは単なるギミック。よって説明は省略。

実行結果

このコードを実行すると、

f:id:akashi_keirin:20170416102848j:plain

f:id:akashi_keirin:20170416102853j:plain

無事抽出処理ができた。

このままだと、まあ直接AdvancedFilterメソッド使った方が楽なので、改良が必要かな。

@akashi_keirin on Twitter

名簿作りマクロ(4)

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

過去記事

  1. 名簿作りマクロ(3)
  2. 名簿作りマクロ(2)
  3. 名簿作りマクロ(1)

作成するプロシージャ

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

処理の手順としては、

  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の原則が守れていない気がする。

@akashi_keirin on Twitter

名簿作りマクロ(3)

名簿作りマクロの組立

次のような手順で組み立てる。

  1. 【手順1】ユーザ定義型・列挙型の宣言
  2. 【手順2】定数・変数の宣言
  3. 【手順3】転記マクロの組立

このような手順で進めていきます。

ユーザ定義型・列挙型の宣言

コードの可読性を上げるために、列挙型を駆使する。

リスト1-1 ユーザ定義型
Public Type Racer
  rcName As String
  rcPhonetic As String
  belongsTo As String
  graduateTerm As Integer
  rcGrade As String
  rcClass As String
  rcStyle As String
  isEliminated As Boolean
End Type

選手データを格納するための変数の束。

ワークシートとの対応は、

f:id:akashi_keirin:20170415090500j:plain

画像の通り。

リスト1-2 列挙型orgCol
Public Enum orgCol
  rcName = 1
  rcPhonetic
  belongsTo
  graduateTerm
  rcGrade
  rcClass
  rcStyle
  isEliminated
End Enum

転記元ワークシート各列の名称を定義している。

ワークシートとの対応は、

f:id:akashi_keirin:20170415090506j:plain

画像の通り。

リスト1-3 列挙型styleCol
Public Enum styleCol
  prefNum = 1
  styleNum
  rcPhonetic
  rcStyle
  rcName
  graduateTerm
  rcGrade
  rcClass
  belongsTo
End Enum

転記先の「戦法別」ワークシート各列の名称を定義している。

ワークシートとの対応は、

f:id:akashi_keirin:20170415090512j:plain

画像の通り。

リスト1-4 列挙型prefCol
Public Enum styleCol
  prefNum = 1
  styleNum
  rcPhonetic
  rcStyle
  rcName
  graduateTerm
  rcGrade
  rcClass
  belongsTo
End Enum

転記先の「都道府県別」ワークシート各列の名称を定義している。

ワークシートとの対応は、

f:id:akashi_keirin:20170415090521j:plain

画像の通り。

同じ内容の列を、同じ識別子で呼び出せるようにしているので、書きやすく、読みやすくなっていると思う。

定数・変数の宣言

リスト2-1 定数の宣言
Public Const PROCESS_STYLE As Integer = 1    '……(1)
Public Const PROCESS_PREF As Integer = 2
Public Const ORG_START_ROW As Integer = 2    '……(2)
Public Const STYLE_START_ROW As Integer = 3
Public Const PREF_START_ROW As Integer = 3

(1)からの2行は、「戦法別」シートへの転記と「都道府県別」シートへの転記を切り替えるために渡す引数として使う。

(2)からの3行は、転記元の「選手データ」シート、「戦法別」シート、「都道府県別」シートそれぞれのデータ開始行を指定するためのもの。

後でシートに変更が加わった場合に、極力宣言セクションだけの変更にとどめるためにこうした。うまいやり方なのかどうかは分かりません。

リスト2-2 変数の宣言
Dim gblRacer As GambleRacer    '……(1)
Dim cdGetter As CodeGetter

Dim racerData As Racer    '……(2)

Dim orgSh As Worksheet    '……(3)
Dim styleSh As Worksheet
Dim prefSh As Worksheet

(1)からの2行は、それぞれGambleRacerクラス、CodeGetterクラスのインスタンス用の変数。

GambleRacerクラスについては、コチラ、CodeGetterクラスについてはコチラをご覧ください。

(2)はリスト1-1で定義したRacer型の変数。

(3)からの3行は、転記元の「選手データ」シート、転記先の「戦法別」、「都道府県別」シートそれぞれを格納する変数。多くの細かい処理をメインのコードから切り出した関係で、モジュールレベルでの宣言にした。その都度ワークシートを引数として持たせるのもメンドクサイので。これまた賢いやり方なのかどうかは分からん。

次回予告

思いのほか長くなってしまった。ここまでが下ごしらえ。クラスを作ったり、列挙型を作ったりしたことで、ほとんど思いつくままにコードが書けるようになったと思う。

ホントは今回で終わらせたかったんだけど、既にかなり長くなってしまったので、次こそは完成まで持って行きます。

@akashi_keirin on Twitter