名簿作りマクロ(4)
名簿作りマクロ メインコードの組立
過去記事
作成するプロシージャ
まず、転記処理の流れを整理しておこう。
- 【プロシージャ１a】「戦法別」シートへの転記開始用プロシージャ
- 【プロシージャ１b】「都道府県別」シートへの転記開始用プロシージャ
- 【プロシージャ２】データ転記メイン処理用プロシージャ
- 【プロシージャ３】Racer型変数へのデータセット用プロシージャ
- 【プロシージャ4-1a】「戦法別」シートへのデータ１件分転記用プロシージャ
- 【プロシージャ4-1b】「都道府県別」シートへのデータ１件分転記用プロシージャ
- 【プロシージャ4-2a】「戦法別」シートのデータ並べ替え用プロシージャ
- 【プロシージャ4-2b】「都道府県別」シートのデータ並べ替え用プロシージャ
処理の手順としては、
- プロシージャ１で転記先シートの準備をして、プロシージャ２を呼び出す
- プロシージャ２では、まずプロシージャ３を呼び出してGambleRacerクラスのインスタンス用の基礎データを準備する
- プロシージャ２に戻ってGambleRacerクラスのインスタンスにデータをセット
- プロシージャ4-1を呼び出してデータを転記先シートに追記
- 全ての転記が終わったら、プロシージャ4-1を呼び出してデータを並べ替える
といったものになる。
【プロシージャ１】
転記先シートへの転記開始用プロシージャ
転記先シートが２つあるので、２種類のプロシージャを作る。
リスト１a 「戦法別」シートへの転記開始用プロシージャ
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
では、見出し以外のセルの値を消去している。
見出しだけを残すには、一旦表全体のセル範囲を獲得してから１つ下にずらせばよいのだから、CurrentRegionプロパティで表全体を取得してから、OffSetプロパティで１つ下にずらした範囲を取得している。
このやり方だと、本来取得したい範囲プラス１行分の範囲を取得してしまうことになるので、本当はResizeプロパティでタテ（行）方向に１つサイズを縮めないといけないんだが、１行余分に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
で、できあがった表に格子罫線を施す。
ただし、「戦法別」シートにできあがった表のＡ～Ｃ列は、並べ替えのキーにするために必要なだけなので、Ａ～Ｃ列には罫線を施さない。
そのために、Resizeプロパティでヨコ(列)方向に３だけ範囲を縮めている。
ま、別にＡ～Ｃ列に罫線があったって構わないんだが、Resizeプロパティの練習ということで……。
リスト１b 「都道府県別」シートへの転記開始用プロシージャ
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
転記先が「都道府県別」シートに変わっただけで、やっていることはリスト１aとほぼ同じなので、説明は省略。
【プロシージャ２】
データ転記メイン処理用プロシージャ
リスト２ データ転記メイン処理用プロシージャ
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)からの２行、
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プロシージャを呼ぶ。最初に書いた処理の手順の２番目に挙げた過程にあたる。
(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)の３行、
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
では、このプロシージャが呼ばれたときの引数に応じて、データ書き込み用プロシージャ２つのうちどちらを呼ぶかを判定している。
ちなみに、(14)の
Call writeDataToStyleSheet
は、引数processNumがPROCESS_STYLEだった場合に実行される。
ここまでで１件分のデータの転記が終わる。
(16)からの２行、
Set gblRacer = Nothing Set cdGetter = Nothing
でインスタンス用の変数を解放。
Forループが終了すると、後は(17)からの６行で、転記先シートの表のデータを並べかえておしまい。
【プロシージャ３】
Racer型変数へのデータセット用プロシージャ
リスト３ 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】
データ１件分転記用プロシージャ
こちらも、転記先シートが２つあるので、２種類のプロシージャを作る。
リスト4-1a 「戦法別」シートへの１件分データ転記用プロシージャ
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 「都道府県別」シートへの１件分データ転記用プロシージャ
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」にあたるやつ）を変数か何かで切り替えられたら便利なんだけど、そうする方法が見当たらなかったので、なんか同じようなコードを２回も書いているというのがちょっと気にくわない。
【プロシージャ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の原則が守れていない気がする。
名簿作りマクロ(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
選手データを格納するための変数の束。
ワークシートとの対応は、
画像の通り。
リスト1-2 列挙型orgCol
Public Enum orgCol rcName = 1 rcPhonetic belongsTo graduateTerm rcGrade rcClass rcStyle isEliminated End Enum
転記元ワークシート各列の名称を定義している。
ワークシートとの対応は、
画像の通り。
リスト1-3 列挙型styleCol
Public Enum styleCol prefNum = 1 styleNum rcPhonetic rcStyle rcName graduateTerm rcGrade rcClass belongsTo End Enum
転記先の「戦法別」ワークシート各列の名称を定義している。
ワークシートとの対応は、
画像の通り。
リスト1-4 列挙型prefCol
Public Enum styleCol prefNum = 1 styleNum rcPhonetic rcStyle rcName graduateTerm rcGrade rcClass belongsTo End Enum
転記先の「都道府県別」ワークシート各列の名称を定義している。
ワークシートとの対応は、
画像の通り。
同じ内容の列を、同じ識別子で呼び出せるようにしているので、書きやすく、読みやすくなっていると思う。
定数・変数の宣言
リスト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-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)からの２行は、それぞれGambleRacerクラス、CodeGetterクラスのインスタンス用の変数。
GambleRacerクラスについては、コチラ、CodeGetterクラスについてはコチラをご覧ください。
(2)はリスト1-1で定義したRacer型の変数。
(3)からの３行は、転記元の「選手データ」シート、転記先の「戦法別」、「都道府県別」シートそれぞれを格納する変数。多くの細かい処理をメインのコードから切り出した関係で、モジュールレベルでの宣言にした。その都度ワークシートを引数として持たせるのもメンドクサイので。これまた賢いやり方なのかどうかは分からん。
次回予告
思いのほか長くなってしまった。ここまでが下ごしらえ。クラスを作ったり、列挙型を作ったりしたことで、ほとんど思いつくままにコードが書けるようになったと思う。
ホントは今回で終わらせたかったんだけど、既にかなり長くなってしまったので、次こそは完成まで持って行きます。
コチラもどうぞ！
Withブロック使用上の注意
Withでまとめるときの注意
実験１
たとえば、ワークシート上に、
こんな表を作ったとする。知性のかけらもないのは許してほしい。
んで、この表に対して、
リスト１
Public Sub test01()
Dim sh As Worksheet
Set sh = ActiveSheet
sh.Range("A1").CurrentRegion.Sort _
key1:=sh.Range("A1"), _
order1:=xlAscending, _
Header:=xlNo '……(1)'
sh.Range("A7").Value = "デコスケ" '……(2)'
sh.Range("A1").CurrentRegion _
.Borders.LineStyle = xlContinuous '……(3)'
End Sub
こんなコードを実行したとする。
(1)の
sh.Range("A1").CurrentRegion.Sort _
key1:=sh.Range("A1"), _
order1:=xlAscending, _
Header:=xlNo
でＡ１セルを含むアクティブセル領域を昇順に並べ替えて、
(2)の
sh.Range("A7").Value = "デコスケ"
でＡ７セルに「デコスケ」と書き込み、
(3)の
sh.Range("A1").CurrentRegion _
.Borders.LineStyle = xlContinuous
でＡ１セルを含むアクティブセル領域に格子罫線を施しているので、
当然こうなる。
実験２
で、リスト１を次のように書き換えてみる。
リスト２
Public Sub test02()
Dim sh As Worksheet
Set sh = ActiveSheet
With sh.Range("A1").CurrentRegion '……(1)'
.Sort key1:=sh.Range("A1"), _
order1:=xlAscending, _
Header:=xlNo
sh.Range("A7").Value = "デコスケ" '……(2)'
.Borders.LineStyle = xlContinuous '……(3)'
End With
End Sub
要するに、
sh.Range("A1").CurrentRegion
を２回も書くのがうっとうしいので、Withでまとめたわけだ。ちょうど、共通因数を括り出したような感じだな。
んで、こいつを実行すると、
こうなる。オーマイガ━━(ﾟДﾟ;)━━ン!
原因
リスト２の(1)、
With sh.Range("A1").CurrentRegion
の時点で、CurrentRegionプロパティには、Ａ１～Ａ６セルの範囲がセットされている。
んで、(2)の
sh.Range("A7").Value = "デコスケ"
で、Ａ７セルに値が入るので、CurrentRegionプロパティがＡ１～Ａ７セルになりそうなもんなんだが、(3)の
.Borders.LineStyle = xlContinuous
の実行結果
からすると、CurrentRegionプロパティはＡ１～Ａ６セルのまんま。
つまり、オブジェクトの取得はWithでまとめたそのときだけ、ということなんだな。
まあ、だからこそ計算（＝プロパティの取得）回数が減らせるわけで、ごくごく当たり前のことなんだが、この程度のことでちょっと（ほんのちょびっとですけど）ハマったので、覚書として残しておく。
おわりに
With～End Wtihは共通因数でくくるみたいなもん
と思っていましたけど、そういう雑な理解だと失敗するよ、というお話でした。
文字列のカッコで括られた部分だけを狙い撃ちで削除するマクロ (2)
ネストされたカッコにも対応する
前回の記事が、この過疎ブログには珍しく反響があったので、ちょっと追加。
Replaceメソッドを使う方あり、Split関数を使う方あり、果ては正規表現を使うツワモノまで現れる始末……。
こうなったら、私も意地になって改良を加えますよー！
前回のコードの欠点
始めカッコがあったらスイッチオン、終わりカッコに出会ったらスイッチオフ、という単純なつくりなので、
たとえばこんなふうにカッコが設置されていたら、
途端に破綻……orz
そこで、少しだけコードに改良を加える。
改良したコード
リスト１
Sub deleteContents()
Dim objCell As Range
Dim objStr As String
For Each objCell In Selection
objStr = objCell.Value
objCell.Value = _
deleteContentsEnclosedByBracket _
(objStr, "(", ")")
Next
End Sub
Private Function deleteContentsEnclosedByBracket _
(ByVal objStr As String, _
ByVal startBracket As String, _
ByVal endBracket As String) As String
Dim enableToDelete As Boolean
Dim tmp As String
Dim chr As String
Dim i As Integer
Dim n As Integer
n = 0
For i = 1 To Len(objStr)
chr = Mid(objStr, i, 1)
If chr = startBracket Then
n = n + 1 '……(1)'
enableToDelete = True
End If
If chr = endBracket Then
n = n - 1 '……(2)'
If n = 0 Then '……(3)'
enableToDelete = False
chr = ""
End If
End If
If enableToDelete = False Then
tmp = tmp & chr
End If
If enableToDelete = True Then
End If
Next
deleteContentsEnclosedByBracket = tmp
End Function
リスト１の説明
改良ポイントは、
カウンタ式フラグ n を導入した
こと。
まず、(1)のところ。
If chr = startBracket Then n = n + 1 enableToDelete = True End If
開始カッコと出会うたびに n をインクリメントする。
んで、(2)と(3)。
If chr = endBracket Then
n = n - 1 '……(2)'
If n = 0 Then '……(3)'
enableToDelete = False
chr = ""
End If
End if
終わりカッコに出会うたびに、逆に n をデクリメントする。これが(2)。
で、n が 0 になっていたら、削除可能フラグをOffにした上で、終わりカッコを""にする。
たとえば、対象文字列が ( (ち～んｗ) )！ だったとすると、
- Forループ１回目で「(」に出会うので、削除可能フラグenableToDeleteはTrue、n が1になる
削除フラグOnなので、「(」はtmpには追加されない→消されたように見える - Forループ２回目で「(」に出会うので、削除可能フラグenableToDeleteはTrue、n が2になる
削除フラグOnなので、「(」はtmpには追加されない→消されたように見える - Forループ３回目
削除可能フラグenableToDeleteがTrueなので「ち」はtmpに追加されない→消されたように見える - Forループ４回目
削除可能フラグenableToDeleteがTrueなので「～」はtmpに追加されない→消されたように見える - Forループ５回目
削除可能フラグenableToDeleteがTrueなので「ん」はtmpに追加されない→消されたように見える - Forループ６回目
削除可能フラグenableToDeleteがTrueなので「ｗ」はtmpに追加されない→消されたように見える - Forループ７回目で「)」に出会うのが、n が1になるだけなので、削除可能フラグenableToDeleteはTrueのまま
削除可能フラグenableToDeleteがTrueなので「)」はtmpに追加されない→消されたように見える - Forループ８回目で「)」に出会い、今度は n が 0 になるので、削除可能フラグenableToDeleteがFalseになる
削除フラグOffになるが、「)」は""になるのでtmpには追加されない→消されたように見える - Forループ９回目、enableToDeleteはFalseになっているので、「！」はtmpに追加される
という流れで、カッコ内の文字列が除去され、「！」だけが残ることになる。
実行結果
この状態で実行すると、
ほれ、この通り。カッコがネストされていても望む結果が得られた。
おわりに
コレ、むきになって更新するようなことなのかね……？？？
名簿作りマクロ(2)
文字列をコード番号に置き換えて取得する
前回
のつづき。
VLOOKUPのちょっと邪道な（？）使い方
一覧表の中の文字列をコード番号に変換するのには、VLOOKUPを使うというのが一般的だと思う。
ただ、私は、一覧表にずらずらとVLOOKUPの数式が並んでいるのがどうもイヤなんですよねー。
そこで、VLOOKUPを限定的に使うという方法をよく使う。
まあ、そもそもそんなことしなくて済むようにデータ集めりゃいいんですけどね。
で、どうすんの？
とにかく、対応する値さえ取得できりゃいいんだから、
セルの名前：PrefName
ここには都道府県名を突っ込みます。
セルの名前：PrefNumber
このセルにはVLOOKUPの数式を入れていて、"PrefName"セルの値をセル範囲"PrefTableReverse"で表引きした値がこのセルに返ります。
セルの名前：RacingStyle
ここには戦法名を突っ込みます。
セルの名前：RacingStyleNumber
上と同様、"RacingStyle"セルの値をセル範囲"RacingStyleTableReverse"で表引きした値がこのセルに返ります。
こんなふうに、値取得専用のセルを準備して、参照用のセルに値を突っ込んでは、返り値用のセルで必要な値を取得する（どうでもいいけど分かりにく表現だな、オイ）ことを繰り返すわけです。
コード番号取得用クラス
やはりここでも無駄にクラスモジュールを使いますよ。
例によってクラスモジュールを挿入して、オブジェクト名を「CodeGetter」にする。
リスト1-1 フィールド・アクセサ部分
Option Explicit 'フィールド Private prefNum_ As Integer Private styleNum_ As Integer 'アクセサ Public Property Get prefNum() As Integer prefNum = prefNum_ End Property Public Property Get styleNum() As Integer styleNum = styleNum_ End Property
まあ、何の変哲もないコード。
例によって、コンストラクタはなし。
リスト1-2 メソッド部分
'メソッド
Public Sub getCode(ByVal pStr As String, _
ByVal sStr As String) '……(1)
Range("PrefName").Value = pStr '……(2)
prefNum_ = Range("PrefNumber").Value '……(3)
Range("RacingStyle").Value = sStr '……(4)
styleNum_ = Range("RacingStyleNumber").Value '……(5)
End Sub
リスト1-2の説明
(1)の
Public Sub getCode(ByVal pStr As String, _
ByVal sStr As String)
で引数を２つ設定している。第１引数は都道府県名、第２引数が戦法名。
まず(2)では、
Range("PrefName").Value = pStr
と、引数で受け取った文字列を、"PrefName"セルにセット。
すると、"PrefNumber"セルのVLOOKUP関数が表引きの結果である都道府県コード番号を返すので、
prefNum_ = Range("PrefNumber").Value
と、その値を即クラス内の仮変数prefNum_にセット。prefNum_にセットされた値は、prefNumプロパティが参照されたときにprefNumプロパティの値として呼び出されることになる。
戦法についても、(4)、(5)で同様に戦法コードをクラス内の仮変数styleNum_にセット。
要するに、CodeGetterクラスのインスタンスに都道府県名と戦法名を渡してgetCodeメソッドを実行したら、CodeGetterクラスのインスタンスは都道府県コードと戦法コードの２つの値を保持するようになる、ということだ。
CodeGetterクラスを利用するコード
こちらは、標準モジュールに書く。
リスト２
Dim cdGetter As CodeGetter Set cdGetter = New CodeGetter With gblRacer cdGetter.getCode .belongsTo, .rcStyle '……(1) End With
「gblRacer」は、前回ご紹介したGambleRacerクラスのインスタンス。belongsToプロパティ、rcStyleプロパティには、それぞれ都道府県名、戦法名がセットされている。
だから、(1)は、getCodeメソッドに都道府県名と戦法名を渡して実行しているということ。
(1)の実行後は、CodeGetterクラスのインスタンス「cdGetter」が都道府県番号を戦法番号を保持していることになる。
次回予告
今回のように、一時的なデータの置き場所として目に見えるセルが使える、というのがVBAの強みかも知れない。
それに、そこそこ大規模な表だと、VLOOKUPだらけにするとなんか重たい感じがしてイヤなので、こんなやり方で値だけを転記することが多い。まあ、ちょっとした力技なのかも知れませんが。
さて、次回は、前回作成したGambleRacerクラスと、今回のCodeGetterクラスを用いて、いよいよ名簿作りマクロを完成させます。
コチラもどうぞ！
名簿作りマクロ(1)
人物データを元に名簿を作成するマクロ
配置転換で行った先で見たもの
新年度の配置転換で、新しい部署に行くことになった。んで、早速名簿作りをしないといけなくなった。
だいたいこんな感じのものが出てきたと思ってください。
どうやら、
こんな元データを作って、それをいろんな条件で並び替えてコピペすることによって、注目するキーごとの名簿を作っていたみたいだ。あ、もちろん画像はイメージですよ。実際にはもっとたくさんパラメータのある大がかりな表です。
せいぜい200人分ぐらいの名簿だから、大したことないといえば大したことのない名簿作りだけど、よくやるよ、ホントに。
ナマケモノの私は、もちろんマクロでやることを考えましたよ。たとえ１回こっきりでもマクロでやりますね。だって、その方が楽しいから(ｷﾘｯ
方針
もちろん、クラスモジュール入門者なので、今回も無駄にクラスモジュール使いますよ。
それぞれのワークシートはこんな感じ。
んで、「参照」と名付けたシートのＢ１～Ｅ１セルには、
こんな風に、名前を定義したり、数式を入れたりしている。
処理の手順としては、
- 選手を表すクラスを作る
- 「選手データ」シート１行分のデータを選手クラスのインスタンスに持たせる
- 「戦法別」または「都道府県別」シートにデータを転記する
- 全部転記し終わったらそのシートにふさわしいやり方でデータを並べ替える
とまあ、こんなところか。
選手クラスを作る
リスト１
クラスモジュールを挿入して、オブジェクト名は「GambleRacer」にする。
フィールド
Option Explicit 'フィールド' Private rcName_ As String '……選手名' Private rcPhonetic_ As String '……ふりがな' Private belongsTo_ As String '……都道府県' Private prefNum_ As Integer '……都道府県No.' Private graduateTerm_ As Integer '……卒業期' Private rcGrade_ As String '……級' Private rcClass_ As String '……班' Private rcStyle_ As String '……戦法' Private styleNum_ As Integer '……戦法No.' Private isEliminated_ As Boolean '……失格フラグ'
……とまあ、選手のパラメータです。
アクセサ
'アクセサ' Public Property Get rcName() As String rcName = rcName_ End Property Public Property Get rcPhonetic() As String rcPhonetic = rcPhonetic_ End Property Public Property Get belongsTo() As String belongsTo = belongsTo_ End Property Public Property Get prefNum() As Integer prefNum = prefNum_ End Property Public Property Get graduateTerm() As Integer graduateTerm = graduateTerm_ End Property Public Property Get rcGrade() As String rcGrade = rcGrade_ End Property Public Property Get rcClass() As String rcClass = rcClass_ End Property Public Property Get rcStyle() As String rcStyle = rcStyle_ End Property Public Property Get styleNum() As Integer styleNum = styleNum_ End Property Public Property Get isEliminated() As Boolean isEliminated = isEliminated_ End Property
……とまあ、何の変哲もないコードです。例によってLetは作っていない。値のセットについては、別途メソッドを作る方が性に合っている気がする。これは完全に個人の好みです。
コンストラクタ
今回もありません。
メソッド
'メソッド'
Public Sub setData(ByRef rcData As Racer)
With rcData
rcName_ = .rcName
rcPhonetic_ = .rcPhonetic
belongsTo_ = .belongsTo
graduateTerm_ = .graduateTerm
rcGrade_ = .rcGrade
rcClass_ = .rcClass
rcStyle_ = .rcStyle
isEliminated_ = .isEliminated
End With
End Sub
Public Sub setCode(ByVal pNum As Integer, _
ByVal sNum As Integer)
prefNum_ = pNum
styleNum_ = sNum
End Sub
メソッドは２つ。一覧表から直に値を渡すことができるやつは、setDataメソッドで。ちなみに、メソッドの引数は自作の構造体で渡している。めんどくさいけど、書きやすさと読みやすさはバツグン。……ていうか、ここまでするんなら、いっそクラスをこのクラスのフィールドにしてしまえば良いような気もする。
んで、２つ目のsetCodeメソッドなんですが、元の表が、都道府県とか戦法なんかをベタの文字列で表しているのがそもそもの間違いなんですよねー。後で並べ替えのキーにすることが分かってるんだから、初めから振り番しといて、別の「都道府県番号表」とか「戦法番号表」なんかと紐付けしてりゃよかったんですよ。
データベースのなんたるかが全く分かってないやつ（まあ、私も大して分かってやしませんが）がデータ処理の基礎部分を作ってしまうと、後任の者が異様に苦労する、ということですな。
おっと、話がそれてしまった。
ともかく、都道府県と戦法については、後で並べ替えのキーにするために数値化しないといけない。そのために、「参照」シートでVLOOKUPなんか使っているわけなんですよ。
いや、もちろん、元データの表にVLOOKUPをゴリゴリ押し込むこともできるんですけど、VLOOKUPだらけの表ってなんか品がないような気がするんですよ。
リスト２ 標準モジュールの宣言セクション
GambleRacerクラスのsetDataメソッドに引数を大量に渡すのがメンドクサイので、基礎データにあたる部分を構造体にして渡すことにした。その宣言が以下のコード。
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 Dim racerData As Racer
……とまあ、こんな感じ。
次回予告
後は、GambleRacerクラスのインスタンスに、
- setDataメソッドを使って「選手データ」シートの各データをセットし、
- setCodeメソッドを使って都道府県番号、戦法番号をセットし、
- 「戦法別」または「都道府県別」シートに各パラメータを書き込ませる
ということをデータの数だけ繰り返したら、一覧表が完成することになる。
クラスって、作るまでが結構メンドウだけれど、一旦作ってしまうと、その後のプログラミングとメンテナンスが異様に楽になる。まだまだちゃんと使いこなせているわけではないけど、十分メリットを感じている。
コチラもどうぞ！
ループ処理で何もせずにカウンタだけ前に進める
何もせずに次のループに進む
ForループやDoループを書いているとき、
先頭で条件判定して、当てはまっていたら何もせずに次のループに進むことができたらいいのに
と思うことがちょいちょいある。
もちろん、たとえば、
リスト１
For i = 1 to hogehoge
If foo = "bar" Then
'処理１
'処理２
'処理３
'処理４
・
・
・
・
・
End If
Next
こんな風にしてやれば良いというのは分かっているんだけど、処理が結構な行数に及ぶ場合、Ifブロックがタテに長～くなるのはちょっとイヤなんですよねー。
For（Do）ループ先頭にガード節を置く
最近、ちょっとハマっている「ガード節」という考え方。
入り口のところで門前払いを食らわしてしまう、というのはIfブロックと同じなんですけどね。
たとえば、
リスト２
For i = 1 to hogehoge
If foo = "bar" Then GoTo myJump '……(1)
'処理１
'処理２
'処理３
'処理４
・
・
・
・
・
myJump: '……(2)
Next
こんな感じ。
(1)がガード節に当たる部分で、条件（この場合は変数fooの値が文字列「bar」だったらというもの）に当てはまっていたらNextの直前までワープさせる、というやり方で、処理１、処理２……をすっ飛ばしてiをインクリメントする、という処理を実現している。
おわりに
う～ん……。GoToの行き先になるラベルってインデントが効かない（強制的に左端に戻される）から、For～Nextブロックの視認性が落ちてしまうんだよなあ……。
何かいい方法があったら教えろください。
