ゼロ埋め番号文字列を作る関数を自作した

ゼロ埋め番号を作る関数

調子に乗って関数化

こいつら

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

をもとに、最大数に応じてゼロ埋め数字の文字列を返す関数を作ってみた。

仕様

書式

createNumberFilledByZero(最大数 , 対象数)

第1引数「最大数」には、ゼロ埋めケタ数の基準になる最大の数を指定する。Long型。たとえば、「1000」を指定すると4ケタのゼロ埋め数字文字列を作ることになる。

第2引数「対象数」には、ゼロ埋めにしたい数字を指定する。Long型。たとえば、第1引数が「1000」のときに、第2引数に「15」を指定すると、「0015」が返ることになる。

返り値

String型。第2引数で指定した数字を、第1引数によって決まるケタ数のゼロ埋め数字文字列にしたものが返る。処理中にエラーがでた場合は、「""」を返す。

ソースコード

リスト1
Public Function createNumberFilledByZero(ByVal numberOf As Long, _
                                         ByVal currentNumber As Long) As String
On Error GoTo errorHandler
  Dim maxNum As Long
  maxNum = numberOf
  Dim objNumber As Long
  objNumber = currentNumber
  Dim formatString As String
  Dim n As Integer
  Dim i As Integer
  n = Len(CStr(maxNum)) - 1
  formatString = String(n, "0") & "#"
  createNumberFilledByZero = Format(objNumber, formatString)
  Exit Function
errorHandler:
  createNumberFilledByZero = ""
End Function

イミディエイト・ウインドウで実行するために、アクセス修飾子は「Public」にしてあります。必要に応じて「Private」にしたら良いと思います。

実行結果

イミディエイト・ウインドウに、

?createNumberFilledByZero(10000,5)

及び、

?createNumberFilledByZero(1000,5)

と書いて実行した結果が、

f:id:akashi_keirin:20170716082517j:plain

コチラ。

ゼロ埋め番号ができている。

おわりに

何か意味あるんだろか、コレ???

@akashi_keirin on Twitter

String関数なるものの存在を知った

String関数を使う

前回の

akashi-keirin.hatenablog.com

に、id:imihito さんからコメントをいただいた。

特定の1文字の繰り返しは
String関数(名前が紛らわしいですが)を使うと簡単に作れたりします。
VBA.Strings.String$(2, "0")

とのこと。

へえ! 知らなんだ。

VBA界隈では超有名なOffice TANAKAさんによると、

String関数

構文

String(num,character)

引数numには、文字をいくつ並べるかを指定します。

引数characterには、並べる文字を示す文字コード、または文字を指定します。

解説

引数characterで指定した文字コードに該当する文字、または引数characterで指定した文字列の先頭文字を、引数numで指定した回数並べた文字列を返します。

ということなので、コイツを使ったらゼロ埋め用の書式文字列を作るのが簡単にできそう。

コーディング

前回使用したコードでは、ゼロ埋め用に複数の「0」をつなげるのに、Forループを用いた。

Dim i As Integer
Dim n As Integer
Dim formatString As String
n = Len(CStr(objNum)) - 1
For i = 1 To n    '……(*)'
  formatString = formatString & "0"
Next
formatString = formatString & "#"

(*)のところですね。

「最大ケタ数-1」個の「0」をつなげた文字列を作るために、1つづつ「0」をつないでいる。

String関数を使えば、これを

Dim n As Integer
Dim formatString As String
n = Len(CStr(objNum)) - 1
formatString = String(n, "0") & "#"    '……(1)'

おおっ! 最後に「#」を付けるところまで含めて、こんなに簡単に書ける!

実行結果

前回使用したコードを次のように改めて実行。

リスト1
Public Sub testFormatFunction()
  Dim objNum As Integer
  objNum = 105
  Debug.Print objNum & "個のゼロ埋め文字列を作ります。"
  Dim i As Integer
  Dim n As Integer
  Dim formatString As String
  n = Len(CStr(objNum)) - 1
  formatString = String(n, "0") & "#"    '……(*)'
  For i = 1 To objNum
    Debug.Print Format(i, formatString)
  Next
End Sub

(*)のところが変更箇所。

実行すると、

f:id:akashi_keirin:20170716075058j:plain

以下省略。

ほれ、ちゃんとゼロ埋めの文字列ができておる。

おわりに

ある程度VBAで意図通りの処理ができるようになってくると、ついつい手持ちの知識だけでどうにかしてしまう、ということになる。

んで、その結果として

ちょっと知識があればカンタンに書ける処理

を、

すんげー力技で解決しちゃう

ということになる。

ある程度自力でコーディングできるようになってきたら、改めてVBA関数一覧なんかを読み直してみる必要があるなあ、と感じました。

久しぶりに入門書を読み直してみるとするか。

それにしても、そもそも

String関数の本来の使い道って何なのだろう……???

@akashi_keirin on Twitter

ゼロ埋め連番を作成する

Format関数の第2引数は、変数でも良かった

ゼロ埋め連番文字列を動的に生成する

たとえば、

akashi-keirin.hatenablog.com

こんなマクロを使って大量にファイルを生成するような場合、ファイル名の先頭がゼロ埋め連番になっていると非常に都合が良い。

で、やってみた。

考え方

次のような手順で、適切な桁数のゼロ埋め連番文字列が得られると考えた。

  1. 個数の桁数を数える
  2. 「0」を「個数の桁数-1」個連結した文字列を作り、変数に格納する
  3. 2.でできた文字列に、「#」を連結し、変数に格納する
  4. 3.まででできた文字列をFormat関数の第2引数とする

コーディング

リスト1
Public Sub testFormatFunction()
  Dim objNum As Integer
  objNum = 105    '……(*)'
  Debug.Print objNum & "個のゼロ埋め文字列を作ります。"
  Dim i As Integer
  Dim n As Integer
  Dim formatString As String
  n = Len(CStr(objNum)) - 1    '……(1)'
  For i = 1 To n    '……(2)'
    formatString = formatString & "0"
  Next
  formatString = formatString & "#"
  For i = 1 To objNum
    Debug.Print Format(i, formatString)    '……(3)'
  Next
End Sub

(*)で、変数objNumに105を代入しているので、とりあえず105までの連番をゼロ埋めで作ることになる。

(1)の

n = Len(CStr(objNum)) - 1

でobjNum(今回は「105」)のケタ数(今回は「3」)から1引いた数を変数 n に代入している。

Len関数の引数なんだが、

Len(CStr(objNum))

と、objNumをString型にキャストして渡している。

別に

Len(objNum)

でも良さそうなもんだが、実際そうすると、

f:id:akashi_keirin:20170709215538j:plain

こんなふうに、Len関数の返り値が「2」になっている。

イミディエイト・ウインドウに

?Len(105)

とすると、

f:id:akashi_keirin:20170709215618j:plain

こんなふうにコンパイル・エラーになる。

ちょっとggってみると、こういうことらしい。

指定された文字列の文字数、または変数の格納に必要な名目上のバイト数を含む整数型の値を返します。

ということは、単純に

Len(objNum)

としたときの返り値はInteger型の変数のバイト数だったってことか。納得。

話を元に戻そう。

(2)からの4行

For i = 1 To n
  formatString = formatString & "0"
Next
formatString = formatString & "#"

では、Format関数の第2引数を作っている。

今回の例の場合、3ケタのゼロ埋め数字ができれば良いのだから、Format関数の第2引数は、

"00#"

になれば良い。

今回、数字の個数は「105」。すなわち、3ケタのゼロ埋めになれば良い。(1)の段階で変数 n には「2」が入っているので、まずForループで「"00"」ができて、Forループ終了。

最後に、「#」を付け加えるので、変数formatStringの中身はめでたく「00#」になっている。

これを(3)の

Debug.Print Format(i, formatString)

でFormat関数の第2引数として渡してDebug.Printでイミディエイト・ウインドウに変数 i を出力する。

実行結果

f:id:akashi_keirin:20170709215526j:plain

まず最初にこんなふうに表示され、

f:id:akashi_keirin:20170709215551j:plain

f:id:akashi_keirin:20170709215608j:plain

こんなふうに、ゼロ埋めで数字が出力された。

おわりに

ゼロ埋め連番のケタ数を、対象データの個数に応じて動的に設定できるので、それなりに重宝するかも。

@akashi_keirin on Twitter

任意のワークシートを新規Excelブックとして出力するクラス

ワークシートを新規Excelブックとして出力するクラス

ワークシートを新規Excekブックとして出力する

名簿なんかの一覧表をマクロで自動作成して、相手方にPDFで提供すると、しばしば

加工したいからExcelのままでくれ!

と言われることがよくある。

大量(っつっても大した量でもないけど)の元データやマクロだらけのブックをそのまま送りつけるわけにも行かないので、必要なシートだけを新しいブックにコピペして提供、という形になる。

ただ、それも1つや2つなら手作業でポンとやっておしまい、なんだが、次から次へ、となるとさすがにめんどくさい。

で、やってみたのが

akashi-keirin.hatenablog.com

なんだが、今後こうした作業が頻発することが予測されるのでクラス化しといた。

任意のワークシートを新規Excelブックとして出力するクラス

リスト1 クラスモジュール ExcelFileCreator
Option Explicit

Private Const NOT_INITIALIZED As Integer = 1
Private Const NOT_CREATED As Integer = 2

'Fields'
Private targetSheet_ As Worksheet
Private filePath_ As String
Private newWorkbook_ As Workbook
Private isInitialized_ As Boolean

'Accessor'
Public Property Get newWorkbook() As Workbook
  Set newWorkbook = newWorkbook_
End Property

'Constructor'
Public Sub init(ByVal Sh As Worksheet)
  '引数としてExcelファイル化したいWorksheetオブジェクトを受け取る'
  Set targetSheet_ = Sh
  isInitialized_ = True
End Sub

'Methods'
Public Sub createExcelFile(ByVal fullPath As String, _
                           Optional ByVal isOnlyToCreate As Boolean)
  '引数fullPathは、新たに作成するExcelファイルのフルパス'
  '新しいExcelファイルを作成するだけでよいなら、引数isOnlyToCreateをTrueにする'
  If isInitialized_ = False Then Call raiseError(NOT_INITIALIZED)
  filePath_ = fullPath
  Set newWorkbook_ = Workbooks.Add
  targetSheet_.Copy before:=newWorkbook_.Worksheets(1)
  Application.DisplayAlerts = False
  Dim i As Integer
  With newWorkbook_
    For i = .Worksheets.Count To 2 Step -1
        .Worksheets(i).Delete
    Next
  End With
  Application.DisplayAlerts = True
  If isOnlyToCreate = True Then Call closeCreatedFile
End Sub

Public Sub closeCreatedFile()
  If newWorkbook_ Is Nothing Then Call raiseError(NOT_CREATED)
  Application.DisplayAlerts = False
  newWorkbook_.SaveAs fileName:=filePath_
  newWorkbook_.Close False
  Application.DisplayAlerts = True
End Sub

Private Sub raiseError(ByVal typeOfError As Integer)
  If typeOfError = NOT_INITIALIZED Then
    Err.Raise Number:=10001, _
              Description:="インスタンス生成後にinitメソッドの使用が必要です。"
  End If
  If typeOfError = NOT_CREATED Then
    Err.Raise Number:=10002, _
              Description:="Workbook作成前に使用できません。"
  End If
End Sub

かなりタテ長になってしまったので、パーツごとに解説する。

目次
  1. 宣言セクション
  2. フィールド
  3. アクセサ
  4. コンストラクタ
  5. createExcelFileメソッド
  6. closeCreatedFileメソッド
  7. raiseErrorメソッド
宣言セクション
Private Const NOT_INITIALIZED As Integer = 1
Private Const NOT_CREATED As Integer = 2

今のところ定数を2つ設定している。誤った使い方をした場合にエラーを起こすようにしているが、どのエラーを起こすのかを区別するためのもの。

フィールド
Private targetSheet_ As Worksheet
Private filePath_ As String
Private newWorkbook_ As Workbook
Private isInitialized_ As Boolean

それぞれの変数は、

targetSheet_

Excelブック化する対象のワークシートを格納する。

filePath_

新規Excelブックのフルパスを格納する。

newWorkbook_

新規Excelブックを格納する。

isInitialized_

擬似コンストラクタinitメソッドが実行されたかどうかを格納する。initメソッド実行済みであればTrue。

アクセサ
Public Property Get newWorkbook() As Workbook
  Set newWorkbook = newWorkbook_
End Property

今のところ、外部に公開するプロパティとしては、新しく作成されたブックが格納されているnewWorkbook_フィールドだけで良いと思っている。必要があれば再検討する。

コンストラクタ
Public Sub init(ByVal Sh As Worksheet)
  Set targetSheet_ = Sh    '……(1)'
  isInitialized_ = True    '……(2)'
End Sub

おなじみ、擬似コンストラクタ。引数としてExcelブック化したい対象のWorksheetオブジェクトを渡して実行する。

(1)の

Set targetSheet_ = Sh

で、引数として受け取ったWorksheetオブジェクトを変数targetSheet_に格納。

(2)の

isInitialized_ = True

で変数isInitialized_をTrueにして、initメソッド実行済みかどうか分かるようにしている。

createExcelFileメソッド
Public Sub createExcelFile(ByVal fullPath As String, _
                           Optional ByVal isOnlyToCreate As Boolean)    '……(1)'
  If isInitialized_ = False Then Call raiseError(NOT_INITIALIZED)    '……(2)'
  filePath_ = fullPath
  Set newWorkbook_ = Workbooks.Add
  targetSheet_.Copy before:=newWorkbook_.Worksheets(1)
  Application.DisplayAlerts = False
  Dim i As Integer
  With newWorkbook_
    For i = .Worksheets.Count To 2 Step -1
        .Worksheets(i).Delete
    Next
  End With
  Application.DisplayAlerts = True
  If isOnlyToCreate = True Then Call closeCreatedFile    '……(3)'
End Sub

(1)の

Public Sub createExcelFile(ByVal fullPath As String, _
                           Optional ByVal isOnlyToCreate As Boolean = True)

で、引数を2つ設定している。

第1引数fullPathは、新規に作成するExcelブックのフルパス。

第2引数isOnlyToCreateは、Trueにすると指定したシートをそのままExcelブック化する。シートに何らかの加工をしてからExcelブック化したいなら、この引数をFalseにしておく必要がある。

(2)の

If isInitialized_ = False Then Call raiseError(NOT_INITIALIZED)

では、このクラスのインスタンス生成後、initメソッドが実行されているかどうかを判定し、未実行ならraiseErrorメソッドを呼び出してエラーを起こさせるようにしている。

さて、このメソッドのメインの処理については、前に書いたのと全く同じなので、詳しいことは

akashi-keirin.hatenablog.com

をどうぞ。

(3)の

If isOnlyToCreate = True Then Call closeCreatedFile

では、第2引数の値によって、このまま新規ブックの保存・終了に進むのかどうかを分岐している。

isOnlyToCreateがTrueならば、後は新規ブックを保存して終了するだけなので、closeCreatedFileメソッドを呼び出して終了。Falseだったら一旦ここで処理を中断して標準モジュールのメインのコードに戻ることになる。

closeCreatedFileメソッド
Public Sub closeCreatedFile()
  If newWorkbook_ Is Nothing Then Call raiseError(NOT_CREATED)    '……(1)'
  Application.DisplayAlerts = False
  newWorkbook_.SaveAs fileName:=filePath_
  newWorkbook_.Close False
  Application.DisplayAlerts = True
End Sub

こちらは、新しく作成されたExcelブックに新しいファイル名を付けて保存し、ファイルを閉じる、という処理をしているだけ。

ただ、そもそも新規のブックが作成されてもいないのに、このメソッドを先に実行されてしまったら困るので、(1)の

If newWorkbook_ Is Nothing Then Call raiseError(NOT_CREATED)

で、新規ブック未作成ならcloseCreatedFileメソッドを呼んでエラーを起こさせるようにした。

raiseErrorメソッド
Private Sub raiseError(ByVal typeOfError As Integer)    '……(1)'
  If typeOfError = NOT_INITIALIZED Then
    Err.Raise Number:=10001, _
              Description:="インスタンス生成後にinitメソッドの使用が必要です。"
  End If
  If typeOfError = NOT_CREATED Then
    Err.Raise Number:=10002, _
              Description:="Workbook作成前に使用できません。"
  End If
End Sub

(1)の

Private Sub raiseError(ByVal typeOfError As Integer)

では引数typeOfErrorを設定している。

あとは、受け取ったtypeOfErrorの値に応じてErrオブジェクトのRaiseメソッドを用いてエラーを吐かせているだけ。

今後、新たなエラー原因が分かったら逐次追加していけば良い。

使用例 その1

f:id:akashi_keirin:20170702093636j:plain

こんなシートをアクティブにして次のリスト2-1のコードを実行してみる。

リスト2-1 標準モジュール
Public Sub createExcelFileTest1()
  Dim Sh As Worksheet
  Set Sh = ActiveSheet    '……(1)'
  Dim str As String
  str = ThisWorkbook.Path & "\超人墓場\"    '……(2)'"
  str = str & "都道府県別1.xlsx"
  Dim xlsxCreator As ExcelFileCreator    '……(3)'
  Set xlsxCreator = New ExcelFileCreator    '……(4)'
  xlsxCreator.init Sh    '……(5)'
  xlsxCreator.createExcelFile str, True    '……(6)'
  End With
End Sub

(1)の

Set Sh = ActiveSheet

で、アクティブシートを一旦変数Shに格納。

(2)からの2行

str = ThisWorkbook.Path & "\超人墓場\"  '"
str = str & "都道府県別1.xlsx"

では、新しく作成するブックのフルパスを変数strに格納。2回に分けているのは、可読性とメンテナンス性のため。別に1回で書いてもいい。

(3)の

Dim xlsxCreator As ExcelFileCreator

で、ExcelFileCreatorクラスのインスタンス用の変数xlsxCreatorを準備し、

(4)の

Set xlsxCreator = New ExcelFileCreator

でExcelFileCreatorクラスのインスタンスを生成して変数xlsxCreatorに格納。

(5)の

xlsxCreator.init Sh

でExcelFileCreatorクラスのinitメソッドにSh(対象のWorksheetオブジェクト)を渡して実行。

(6)の

xlsxCreator.createExcelFile str, True

でExcelFileCreatorクラスのcreateExcelFileメソッドにstr(新規ブックのフルパス)を渡して実行。第2引数がTrueなので、指定したWorksheetオブジェクトに何も加工せずに保存・終了することになる。

実行結果

f:id:akashi_keirin:20170702093647j:plain

このように、「超人墓場」フォルダに「都道府県別1.xlsx」ができていて、開くと

f:id:akashi_keirin:20170702093700j:plain

この通り、シートがそのまま保存されている。

ただ、このままだと、いかにもA~C列が邪魔。かといって手動で削除するとなると果てしなくダルい。

そこで、新しいブックを作った後、A~C列を削除した後で保存・終了する、という処理にしてみる。

使用例 その2

リスト2-1を次のように書き換える。

リスト2-2 標準モジュール
Public Sub createExcelFileTest2()
  Dim Sh As Worksheet
  Set Sh = ActiveSheet
  Dim str As String
  str = ThisWorkbook.Path & "\超人墓場\"  '"
  str = str & "都道府県別2.xlsx"
  Dim xlsxCreator As ExcelFileCreator
  Set xlsxCreator = New ExcelFileCreator
  With xlsxCreator
    .init Sh
    .createExcelFile str, False    '……(1)'
    .newWorkbook.Worksheets(1).Columns("A:C").Delete    '……(2)'
    .closeCreatedFile    '……(3)'
  End With
End Sub

変わったのは、

With xlsxCreator
  .init Sh
  .createExcelFile str, False    '……(1)'
  .newWorkbook.Worksheets(1).Columns("A:C").Delete    '……(2)'
  .closeCreatedFile    '……(3)'
End With

この部分だけ。

(1)でcreateExcelFileメソッドを呼び出すときの第2引数をFalseにし、

(2)でA~C列を削除してから、

(3)でcloseCreatedFileメソッドを呼び出して新規ブックを保存・終了している。

実行結果

f:id:akashi_keirin:20170702093721j:plain

このように、「超人墓場」フォルダに「都道府県別2.xlsx」ができていて、開くと

f:id:akashi_keirin:20170702093731j:plain

この通り、A~C列だった部分が削除されてシートが保存されている。

おわりに

今回紹介した程度の処理なんて、フツーに考えたらSubとかFunctionのレベルで再利用すればよいものだと思うが、一連の作業をやっていて、改めて「クラス」って便利だなーと思った次第。

実は、closeCreatedFileメソッドというのは、もともと一連の処理だったものの最後の部分だけを切り出したものなんだが、クラスにしたおかげでめちゃくちゃ簡単に切り出すことができた。

というのも、保存して閉じる、という作業に必要なデータである新規ブックのフルパスを、このクラスのインスタンスが既に保持しているので、いちいちこのメソッドにフルパスを引数として与えなくても済むから。

処理を小分けにして切り出す、という作業をやっていていつもぶつかるのが、

引数祭り

の問題。

処理に必要なパラメータが多いときに、プロシージャ間でのデータのやりとりがめちゃくちゃ煩雑になってしまうのだ。もちろん、変数のスコープを広げたら済む話なんだが、むやみやたらと変数のスコープを広げるのはやっぱり怖い。

その点、クラスのインスタンスにデータを持たせていたら安心。インスタンスが生きている限りいつでもデータを参照できるので。

しかも、単独のSubとかFunctionの場合、ファイル単位ではエクスポートできないけど、クラスモジュールならファイル単位でエクスポートできる。

やっぱりハードVBAerならクラスモジュールを使わない手はないよなあ。

@akashi_keirin on Twitter

「クソ」としか言いようのない魔Excelに勝利した

クソのようなExcel様式に打ち勝った

クソとしか言いようのないExcel様式

「クソ」としか言いようのないExcel様式に出会った。

簡単に言うと、

1つのセルに複数データが入っている

というもの。

しかも、[Alt]+[Enter]によるセル内改行ばかりかと思ったら、スペース連打で成り行き改行まで含まれている始末。

一瞬、軽く途方に暮れかけたが、幸い改行のしかたはともかくとして、全て箇条書きの体になっていたので、それらを1セル1データになるようにする方法を考えた。

1セル1データに整形するための考え方

次のように考えた。

  1. 改行記号を「@」(データ文字列内に決して出てこない記号)に置き換える
  2. 2つ以上連なっているスペースも「@」に置き換える
  3. 2つ以上「@」が連なっている部分を「@」が1つになるまで置き換える
    ここまでで、必要なデータが間に「@」が挟まった状態で1つの文字列になっているはず。
  4. Split関数で各データを配列に格納する。
  5. (データ数-1)行、挿入する
  6. データをセルに書き込んでいく

このような手順。

実装

リスト1
Public Sub splitStrings()
  Dim Sh As Worksheet
  Set Sh = ActiveSheet
  Dim objCell As Range
  Set objCell = ActiveCell
  Dim str As String
  str = objCell.Value
  str = Replace(str, vbCrLf, "@")    '……(1)'
  str = Replace(str, vbCr, "@")
  str = Replace(str, vbLf, "@")
  str = Replace(str, "  ", "@")  '半角スペース2つ'
  str = Replace(str, "  ", "@")  '半角スペースと全角スペース'
  str = Replace(str, "  ", "@")  '全角スペースと半角スペース'
  str = Replace(str, "  ", "@")  '全角スペース2つ'
  Do While InStr(str, "@@") > 0    '……(2)'
    str = Replace(str, "@@", "@")
  Loop
  Dim arrayStr As Variant    '……(3)'
  arrayStr = Split(str, "@")
  Dim i As Integer    '……(4)'
  For i = 1 To UBound(arrayStr)
    Sh.Rows(objCell.Row + i).Insert shift:=xlShiftDown
  Next
  For i = 0 To UBound(arrayStr)    '……(5)'
    With objCell.Offset(i, 0)
      .Value = arrayStr(i)
    End With
  Next
End Sub

まず、(1)からの7行、

str = Replace(str, vbCrLf, "@")
str = Replace(str, vbCr, "@")
str = Replace(str, vbLf, "@")
str = Replace(str, "  ", "@")  '半角スペース2つ'
str = Replace(str, "  ", "@")  '半角スペースと全角スペース'
str = Replace(str, "  ", "@")  '全角スペースと半角スペース'
str = Replace(str, "  ", "@")  '全角スペース2つ'

では、変数strに格納したセル内の文字列について、改行記号や2つ連なったスペースを「@」に置換している。

そして、(2)からの3行、

Do While InStr(str, "@@") > 0
  str = Replace(str, "@@", "@")
Loop

では、2つ以上の「@」の連なりがある限り「@@」を「@」に置換する、という処理を行っている。従って、このループ処理を抜けると、

もともと改行記号や2つ以上のスペースで区切られていた複数の文字列が「@」1つで区切られた状態の文字列

になっているということ。

あとは、(3)からの2行

Dim arrayStr As Variant
arrayStr = Split(str, "@")

で「@」で区切られた文字列をSplit関数でバラして配列変数arrayStrに突っ込み(要素数が未確定なのでVariant型の変数で受ける)、

(4)からの4行、

Dim i As Integer
For i = 1 To UBound(arrayStr)
  Sh.Rows(objCell.Row + i).Insert shift:=xlShiftDown
Next

で必要な数だけ行を挿入し、

(5)からの5行、

For i = 0 To UBound(arrayStr)
  With objCell.Offset(i, 0)
    .Value = arrayStr(i)
  End With
Next

でそれぞれ1セル1データの形で書き込んでおしまい。

実行結果

f:id:akashi_keirin:20170630223732j:plain

こんなふうにアホみたいに書き込まれた5つのデータ。

見た目では分からないが、③と④の間は、セル内改行ではなくスペース連打による見かけ上の改行w

こんなデタラメなデータでも、このセルを選択してマクロを実行すると、

f:id:akashi_keirin:20170630223827j:plain

ほれ、この通り。1セル1データになった。

ちなみに、

f:id:akashi_keirin:20170630223836j:plain

こんなふうに、セル内改行連打の場合でも、

f:id:akashi_keirin:20170630223857j:plain

大丈夫です。

おわりに

それにしても、アクロバチックなExcelの使い方をする人が多すぎて、マジでメンタルやられそうです。。。

@akashi_keirin on Twitter

インタフェースを用いたポリモーフィズム

インタフェースを使ったポリモーフィズム

コードの微修正

akashi-keirin.hatenablog.com

前回のコードをちょっと書き換えてみた。

擬似コンストラクタのinitメソッドをまとめてみただけですが。

リスト1 インタフェース IMusicPlayer
Option Explicit
'Fields'
Private Name_ As String
'Accessor'
Public Property Get Name() As String
  Name = Name_
End Property
'Methods'
Public Sub init(ByVal n As String)
End Sub
Public Sub play()
End Sub
リスト2-1 RecordPlayerクラス
Option Explicit
Implements IMusicPlayer
'Fields'
Private IMusicPlayer_Name_ As String
'Accessor'
Public Property Get IMusicPlayer_Name() As String
  IMusicPlayer_Name = IMusicPlayer_Name_
End Property
'Methods'
Public Sub IMusicPlayer_init(ByVal n As String)
  IMusicPlayer_Name_ = n
End Sub
Public Sub IMusicPlayer_play()
  Debug.Print "レコードを再生するぜ~♪" & vbCrLf & _
              "針が飛ぶから、暴れるんじゃねーぞw"
End Sub
リスト2-2 CDPlayerクラス
Option Explicit
Implements IMusicPlayer
'Fields'
Private IMusicPlayer_Name_ As String
'Accessor'
Public Property Get IMusicPlayer_Name() As String
  IMusicPlayer_Name = IMusicPlayer_Name_
End Property
'Methods'
Public Sub IMusicPlayer_init(ByVal n As String)
  IMusicPlayer_Name_ = n
End Sub
Public Sub IMusicPlayer_play()
  Debug.Print "CDを再生するぜ~♪"
End Sub
リスト2-3 MP3Playerクラス
Option Explicit
Implements IMusicPlayer
'Fields'
Private IMusicPlayer_Name_ As String
'Accessor'
Public Property Get IMusicPlayer_Name() As String
  IMusicPlayer_Name = IMusicPlayer_Name_
End Property
'Methods'
Public Sub IMusicPlayer_init(ByVal n As String)
  IMusicPlayer_Name_ = n
End Sub
Public Sub IMusicPlayer_play()
  Debug.Print "MP3を再生するぜ~♪"
End Sub

見てお分かりの通り、RecordPlayer、CDPlayer、MP3Playerクラスそれぞれに、「IMusicPlayer_init」メソッドを置いてある。

実行用コード

リスト3 標準モジュール
Public Sub musicPlayerTest()
  'インタフェース型配列に各インスタンスを格納'
  Dim iMPlayer(0 To 2) As IMusicPlayer
  Set iMPlayer(0) = New RecordPlayer
  iMPlayer(0).init "レコードプレーヤー1号"
  Set iMPlayer(1) = New CDPlayer
  iMPlayer(1).init "CDプレーヤ1号"
  Set iMPlayer(2) = New MP3Player
  iMPlayer(2).init "ストロングマシン1号"
  'Nameプロパティの出力とplayメソッドの実行'
  Dim i As Integer
  For i = 0 To 2
    With iMPlayer(i)
      Debug.Print .Name
      .play
    End With
  Next
End Sub

実行結果は前回と全く同じなので省略。

おわりに

initメソッドにしても、playメソッドにしても同じような処理なので、これだけだとイマイチありがた味がないけれど、それぞれのクラスが持つメソッドが

似た機能を実現するんだけれども処理の過程が全然違う

ようなものだったら、ポリモーフィズムの威力が分かりやすくなるかも。

たとえば、ThunderbirdのメールとLotusNotesのメールの作成をどちらも同じcreateMailメソッドの呼び出しだけでできるようにするとか。

何にせよ、うまく使いこなせるようになりたいね。

@akashi_keirin on Twitter

Wordドキュメントの表の行を削除する

Wordの表の行を削除する

Wordドキュメント内の表の任意の行を削除する

差込印刷機能を使って似たような書類のWordファイルを自動的に作成するマクロをよく使う。

akashi-keirin.hatenablog.com

Excelで表さえ作ってしまえば、人力でポチポチやるよりも圧倒的に正確かつ高速なので重宝している。

ただ、表を伴うようなもの、しかも表の行数がそれぞれ異なるようなものを作成する羽目になった。

そうしょっちゅう使うこともないと思うので、覚書代わりにアップしとく。

表の行を削除するマクロ

f:id:akashi_keirin:20170625165157j:plain

Wordドキュメントにこんな表があったとする。

何行目かが分かりやすいように表の先頭行以外の左端の列には行番号を入れといた。

リスト1 表の5行目を削除するマクロ
Public Sub tableTest()
  Dim tbl As Table    '……(1)'
  Set tbl = ThisDocument.Tables(1)
  tbl.Rows(5).Delete    '……(2)'
End Sub

(1)からの2行、

Dim tbl As Table
Set tbl = ThisDocument.Tables(1)

では、Table型の変数tblを準備して、ThisDocument上の1つ目の表を格納している。

で、(2)の

tbl.Rows(5).Delete

ではtblに格納したTableオブジェクトのRowsコレクションのうち、5番目のRowオブジェクトに対してDeleteメソッドを使用。

すると、

f:id:akashi_keirin:20170625165205j:plain

こうなる。簡単!

任意の行を削除するFunction

作ってみた。

スト2 表の任意の行を削除するFunction
Private Function deleteRowFromTable(ByVal objTable As Table, _
                                    ByVal rowNum As Integer) As Table    '……(1)'
On Error GoTo errorCatch    '……(2)'
  objTable.Rows(rowNum).Delete
  Set deleteRowFromTable = objTable    '……(3)'
  Exit Function
errorCatch:    '……(*)'
  Set deleteRowFromTable = objTable
End Function

(1)は、

Private Function deleteRowFromTable(ByVal objTable As Table, _
                                    ByVal rowNum As Integer) As Table

の形で引数と返り値を設定。

第1引数がTableオブジェクト、第2引数は削除したい行番号。

で、返り値をTableオブジェクトにした。

行削除後のTableオブジェクトを返すようにしたら便利じゃないかと思っただけw

(2)の

On Error GoTo errorCatch

はエラー対策。今のところ

  • 存在しない行番号を引数として与えた

ぐらいしかエラーの原因は思いつかないけれど、メンドウなのでこの形を使った。

エラーが発生すると、(*)の

errorCatch:
  Set deleteRowFromTable = objTable

に飛んで、処理する。返り値には何もせずに元の表を返す。

(3)の

Set deleteRowFromTable = objTable

で処理済みの表を返す。

実行結果

リスト2のFunctionを、次のコードで使ってみる。

リスト3 実行用コード
Public Sub tableTest()
  Dim tbl As Table
  Set tbl = ThisDocument.Tables(1)
  Debug.Print "使用前:" & tbl.Rows.Count    '……(1)'
  Set tbl = deleteRowFromTable(tbl, 5)
  Debug.Print "使用後:" & tbl.Rows.Count    '……(2)'
End Sub

(1)で実行前の表の行数をイミディエイト・ウインドウに表示し、(2)で実行後の表の行数を表示するようにした。

f:id:akashi_keirin:20170625165219j:plain

ほれ、この通り、指定した行を削除した上で、処理後の表を獲得することができている。

終わりに

WordのVBAは、あまり使う機会がないので、たまに使ったときにちゃんと記録を残しておかないとなあ。

@akashi_keirin on Twitter