親ブックから子ブックを生成する
子ブック生成マクロ
親ブックから子ブックを生成する方法
先日、コチラの記事をうｐしたところ、twitterのフォロワーさんから、
FileCopyステートメントでよくね？？？
的なリプをいただいたのだった。
私自身、
たかがブックの複製を作るぐらいのことでシートを１つ１つコピーした後余分なシートを削除していく
などというやり方は迂遠に過ぎると思っていたところだったので、使ったことなかったけど、FileCopyステートメントとやらを使ってみることにした。
準備
まずは、
こんな親ブックを用意した。
やりたい処理は、
- 「データ」シートＢ列にあるデータ（笑）を「個別」シートのＡ１セルに転記する
- Ａ１セルにデータが書き込まれたブックを「子ブック」として別のフォルダに保存する
というもの。
最終的には、親ブックの「データ」シートにあるＢ列のデータ（笑）を１つづつ転記しては子ブックとして保存、という風にするのだけれど、とりあえず今回は
１つ目のデータ（「アホ」）を転記した子ブックを保存する
だけにしておく。
処理の手順
次のように考えた。
- FileCopyステートメントで親ブックのコピーを別フォルダに作る。
- 新しくできた子ブックを開く。
- データ（笑）を転記する。
- 子ブックを保存して閉じる。
コーディング
次のようにコードを書いた。
リスト１
Option Explicit
Public Sub createChildWorkbook()
Dim originalWorkbook As Workbook
Set originalWorkbook = ThisWorkbook
Dim folderPath As String
folderPath = originalWorkbook.Path & "\収容所\" '"
If Dir(folderPath, vbDirectory) = "" Then MkDir (folderPath)
FileCopy originalWorkbook.FullName, folderPath & "子ブック" '……(*)'
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Open(folderPath & "子ブック.xlsm")
newWorkbook.Worksheets("個別").Range("A1").Value = _
originalWorkbook.Worksheets("元データ").Range("B2").Value
Application.DisplayAlerts = False
newWorkbook.Worksheets("元データ").Delete
newWorkbook.Close True
Set newWorkbook = Nothing
Application.DisplayAlerts = True
End Sub
実行
上記のコードを実行すると、
あっさり一蹴ｗｗｗ
(*)のところでエラーが出ていた。
ちょいとggってみると、コチラのブログがヒット。
それによると、
ExcelのVBAでファイルをコピーする際に使用する"FileCopy"は開かれているファイルをコピーすることはできません。
とのこと。
で、
コピー元ファイルが閉じている(使用されていない)ことを保証できない場合は、ExcelのVBAの"FileCopy"を使用せずに"Scripting.FileSystemObject"の"CopyFile" を使用します。
ということ。なるほど、FileSystemObjectオブジェクトのCopyFileメソッドを使えばいいわけか。
コードの修正
次のように修正。ちなみに、CreateObjectはあんまり使いたくないので、ツール→参照設定で「Microsoft Scripting Runtime」にチェックを入れてNewできるようにしといた。
リスト２
Option Explicit
Public Sub createChildWorkbook()
Dim originalWorkbook As Workbook
Set originalWorkbook = ThisWorkbook
Dim folderPath As String
folderPath = originalWorkbook.Path & "\収容所\" '"
If Dir(folderPath, vbDirectory) = "" Then MkDir (folderPath)
Dim fsObject As FileSystemObject '……(1)'
Set fsObject = New FileSystemObject
fsObject.CopyFile Source:=originalWorkbook.FullName, _
Destination:=folderPath & "子ブック.xlsm"
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Open(folderPath & "子ブック.xlsm") '……(2)'
newWorkbook.Worksheets("個別").Range("A1").Value = _
originalWorkbook.Worksheets("元データ").Range("B2").Value '……(3)'
Application.DisplayAlerts = False
newWorkbook.Worksheets("元データ").Delete
newWorkbook.Close True
Set newWorkbook = Nothing
Application.DisplayAlerts = True
End Sub
(1)からの３行、
Dim fsObject As FileSystemObject
Set fsObject = New FileSystemObject
fsObject.CopyFile Source:=originalWorkbook.FullName, _
Destination:=folderPath & "子ブック.xlsm"
では、FileSystemObjectオブジェクト用の変数にインスタンスをセット。
CopyFileメソッドを用いて新しいブック（子ブック）を別フォルダに保存してしまう。
(2)の
Set newWorkbook = Workbooks.Open(folderPath & "子ブック.xlsm")
では、新しくできた子ブックを開くとともに変数にぶち込み、
(3)の
newWorkbook.Worksheets("個別").Range("A1").Value = _
originalWorkbook.Worksheets("元データ").Range("B2").Value
でデータ（笑）を転記。
後は、「元データ」シートを削除して保存して閉じているだけ。
実行
このように、指定したフォルダに子ブックが保存されている。
子ブックを開くと、無事にデータ（笑）が転記されている。
おわりに
子ブックの生成については、ずいぶん簡単に書くことができた。
ただ、このやり方で困るのは、子ブックがxlsmのままになってしまうこと。
たぶん、前回の記事にid:imihito さんからいただいたコメントのやり方（SaveCopyAsメソッドを使う）でも同じことになると思う。
まあ、ちょっと調べたらできそうな気もするけど、今は本業がいっぱいいっぱいなので、それはまた別の機会に……。
Excelのブックを複製するクラス
子ブックを生み出すクラス
元のブックを開いたままでコピーを作成する
元のブックのシートにデータを入力しては別名で保存して、同じ様式でデータの異なるたくさんのブックを作りたいというときがある。
Worksheetオブジェクトの場合なら、Copyメソッドがあるので簡単にできるが、WorkbookオブジェクトにはCopyメソッドがないので、上記のようなことがしたいときに、不便だなあと思っていた。
ブックの複製を作るときの考え方
- WorkbooksコレクションのAddメソッドで新しいブックを作る。
- 新しくできたブックの先頭に、元のブックのシートをケツから順に挿入していく。
- 新しいブックは、元のブックのシート＋デフォルトのシートの状態になっているので、デフォルトのシートをケツから順に削除していく。
- 新ブックに新しい名前を付ける。
- 新ブックの各セルの参照元を新ブックに改める。
- 新ブックにデータを書き込むなどの処理を施す。
- 新ブックを保存して閉じる。
この手順でやってみた。
子ブックを生み出すクラスの作成
ソースコードを示す。
リスト１ クラスモジュール
※オブジェクト名は「NewWorkbookCreator」
Option Explicit
'Fields'
Private originalWorkbook_ As Workbook
Private newWorkbook_ As Workbook
Private originalFileFullName_ As String
Private newFileFullName_ As String
'Accessor'
Public Property Get newWorkbook() As Workbook
Set newWorkbook = newWorkbook_
End Property
'Constructor'
Private Sub Class_Initialize()
Set originalWorkbook_ = ThisWorkbook
originalFileFullName_ = originalWorkbook_.FullName
End Sub
'Destructor'
Private Sub Class_Terminate()
If Not newWorkbook_ Is Nothing Then Call closeNewWorkbook
End Sub
'Methods'
Public Sub createNewWorkbook(ByVal newFullName As String, _
Optional ByVal enableToChangeLink As Boolean = True, _
Optional ByVal enableToChangeNewWorkbook = True)
'コピー元ブックと同じフルパスを指定していたらエラーを吐かせる。 ……(1)'
If newFullName = originalFileFullName_ Then
Err.Raise Number:=10001, _
Description:="コピー元ブックと同じフルパスでは実行できません。"
Exit Sub
End If
'新ブックを追加。'
Set newWorkbook_ = Workbooks.Add
Dim i As Integer
'コピー先ブックのシート名をデフォルト名から変えておく ……(2)'
With newWorkbook_
For i = 1 To .Worksheets.Count
If .Worksheets(i).Name = "Sheet" & i Then
.Worksheets(i).Name = .Worksheets(i).Name & "_"
End If
Next
End With
'画面更新を止める'
Application.ScreenUpdating = False
'コピー元ブックのシートをケツから順に新ブックの先頭に挿入。 ……(3)'
For i = originalWorkbook_.Worksheets.Count To 1 Step -1
originalWorkbook_.Worksheets(i).Copy before:=newWorkbook_.Worksheets(1)
Next
'新ブックにもともとあったシートを削除 ……(4)'
For i = newWorkbook_.Worksheets.Count To originalWorkbook_.Worksheets.Count + 1 Step -1
'シート削除時のアラートを表示させない。'
Application.DisplayAlerts = False
newWorkbook_.Worksheets(i).Delete
Next
newWorkbook_.SaveAs Filename:=newFullName
'ブック内の参照元ブックを新ブックに改める。 ……(5)'
If enableToChangeLink = True Then
newWorkbook_.ChangeLink name:=originalWorkbook_.FullName, _
NewName:=newWorkbook_.FullName, _
Type:=xlLinkTypeExcelLinks
End If
If enableToChangeNewWorkbook = False Then Call closeNewWorkbook '……(6)'
End Sub
Public Sub closeNewWorkbook() '……(7)'
If newWorkbook_ Is Nothing Then '……(*)'
Err.Raise Number:=10001, _
Description:="新ブック生成前に実行できません。"
Exit Sub
End If
'新ブックを保存して閉じる。'
newWorkbook_.Close True
'アラート表示と画面更新を元に戻す。'
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'オブジェクト変数を空にする。'
Set newWorkbook_ = Nothing
End Sub
(1)の
If newFullName = originalFileFullName_ Then
Err.Raise Number:=10001, _
Description:="コピー元ブックと同じフルパスでは実行できません。"
Exit Sub
End If
はコメントの通り。エラーを吐いてプログラマに知らせるべきことだと思うので、こうした。
(2)では、
With newWorkbook_
For i = 1 To .Worksheets.Count
If .Worksheets(i).Name = "Sheet" & i Then
.Worksheets(i).Name = .Worksheets(i).Name & "_"
End If
Next
End With
新しくできたブックのシート名を変更している。こうしておかないと、最終的にできあがったブックのシート名が、
こんなふうになってしまうし、
数式の参照先も更新されなくなってしまう。
※なぜこうなるのかは、自分で考えてみてください。
(3)の
For i = originalWorkbook_.Worksheets.Count To 1 Step -1 originalWorkbook_.Worksheets(i).Copy before:=newWorkbook_.Worksheets(1) Next
では、WorksheetオブジェクトのCopyメソッドを使って新しいブックの先頭に、元のブックのシートをケツから順に挿入している。こうすることで、新しいブックは、先頭から元のブックのシートが順番通りに並び、その後ろにデフォルトのシートが並んでいる状態になる。2010以前だとデフォルトのシートが３つ、2013以降だとデフォルトのシートは１つだけですね。
で、次は(4)の
For i = newWorkbook_.Worksheets.Count To originalWorkbook_.Worksheets.Count + 1 Step -1 'シート削除時のアラートを表示させない。' Application.DisplayAlerts = False newWorkbook_.Worksheets(i).Delete Next
で新しいブックのケツにくっついている余分なシート（デフォルトのシート）をケツから削除していく。
なぜ「ケツから」なのかは、よく考えてください。
(5)の
If enableToChangeLink = True Then
newWorkbook_.ChangeLink Name:=originalWorkbook_.FullName, _
NewName:=newWorkbook_.FullName, _
Type:=xlLinkTypeExcelLinks
End If
では、新しいブックの数式等の参照先を自分自身に改めている。これをやっておかないと、数式等の参照先が全部元のブックになってしまう。
参照先を元のブックのままにしておきたいときは、このcreateNewWorkbookメソッド実行時に、引数enableToChangeLinkをFalseにすればいいのだが、そのような需要はまずなかろうと思うので、メソッドの定義時に
Optional ByVal enableToChangeLink As Boolean = True
こんなふうに、この引数を省略可能にしてデフォルトをTrueにしておいた。
(6)の
If enableToChangeNewWorkbook = False Then Call closeNewWorkbook
では、引数enableToChangeNewWorkbookの値により、一旦呼び出し元に処理を返すか、このまま新しいブックを保存して閉じるかを分岐している。
単純に全く同じブックを名前だけ変えて複製するのなら、引数enableToChangeNewWorkbookをFalseにして実行すればよい、ということ。まあ、あんまりそんなことはしないと思うけど。
(7)の
Public Sub closeNewWorkbook()
If newWorkbook_ Is Nothing Then '……(*)'
Err.Raise Number:=10001, _
Description:="新ブック生成前に実行できません。"
Exit Sub
End If
'新ブックを保存して閉じる。'
newWorkbook_.Close True
'アラート表示と画面更新を元に戻す。'
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'オブジェクト変数を空にする。'
Set newWorkbook_ = Nothing
End Sub
は、新しいブックを保存して閉じるためのメソッド。
ただし、新しいブックを生成してもいないのにコイツを実行されたら困るので、(*)からの５行、
If newWorkbook_ Is Nothing Then
Err.Raise Number:=10001, _
Description:="新ブック生成前に実行できません。"
Exit Sub
End If
で、newWorkbook_がNothingのとき、すなわちまだ新しいブックが追加されていない場合はエラーを吐くようにした。これまたユーザに知らせるべきことではないと思うので。
あと、今回は珍しくデストラクタを作った。
Private Sub Class_Terminate() If Not newWorkbook Is Nothing Then Call closeNewWorkbook End Sub
新しいブックを作って、処理を施した後のcloseNewWorkbookメソッド実行し忘れを防ぐためなのですが、これで良いのでしょうか……？？？
実行 その１
次のコードで実験してみる。
リスト２ 標準モジュール
Public Sub testNewWorkbookCreator_01() Dim str As String str = ThisWorkbook.Path & "\収容所\" '" 'このブックのあるディレクトリに「収容所」フォルダがなかったら作る。' If Dir(str, vbDirectory) = "" Then MkDir str End If '変数宣言＆インスタンス化' Dim nwbCreator As NewWorkbookCreator Set nwbCreator = New NewWorkbookCreator Dim i As Integer Dim tmp As String For i = 1 To 3 tmp = "_" & Format(i, "0#") nwbCreator.createNewWorkbook newFullName:=str & "新ブック" & tmp, _ enableToChangeLink:=True, _ enableToChangeNewWorkbook:=False '……(*)' Next End Sub
(*)のところで、createNewWorkbookメソッドの引数enableToChangeNewWorkbookをFalseにしているので、単純に元のブックを名前を変えつつ３つ複製するだけのコード。
実行結果
「収容所」フォルダに３つのブックができている。
こんなふうに、参照先も新しいブックになっている。
実行 その２
今度は、次のコードで実行してみる。
リスト３ 標準モジュール
Public Sub testNewWorkbookCreator_02() Dim str As String str = ThisWorkbook.Path & "\収容所\" '" 'このブックのあるディレクトリに「収容所」フォルダがなかったら作る。' If Dir(str, vbDirectory) = "" Then MkDir str End If '変数宣言＆インスタンス化' Dim nwbCreator As NewWorkbookCreator Set nwbCreator = New NewWorkbookCreator Dim i As Integer Dim tmp As String For i = 1 To 3 tmp = "_" & Format(i, "0#") With nwbCreator .createNewWorkbook newFullName:=str & "新ブック加工" & tmp, _ enableToChangeLink:=True, _ enableToChangeNewWorkbook:=True '……(*)' .newWorkbook.Worksheets("Sheet3").Range("A3").Value = .newWorkbook.Name '……(**)' .closeNewWorkbook End With Next End Sub
今度は、(*)のところで、引数enableToChangeNewWorkbookをTrueにした。こうすることで、createNewWorkbookメソッドはcloseNewWorkbookメソッドを呼び出すことなく終了するので、処理が呼び出し元のtestNewWorkbookCreator_02に帰ってきて、(**)を実行することになる。
(**)の
nwbCreator.newWorkbook.Worksheets("Sheet3").Range("A3").Value = .newWorkbook.Name
では、新しいブックのSheet3のＡ３セルに、自身のファイル名を書き込むようにしている。
実行結果
「収容所」フォルダ内に３つのブックができている。
Sheet3のＡ３セルにはファイル名が書き込まれている。
まとめ
NewWorkbookCreatorクラス 仕様
フィールド
- newWorkbook（Workbook型。新しくできたブックを格納する。）
メソッド
- createNewWorkbook(String newFullName,
[Boolean enableToChangeLink],
[Boolean enableToChangeNewWorkbook])
元のブックを複製し、引数newFullNameをフルパスとして保存する。
引数enableToChangeLinkがTrueならば、新しいブックの数式等の参照先は新しいブックになる。
引数enableToChangeNewWorkbookがTrueならば、新しいブックを保存して閉じる前に一旦メソッドの呼び出し元に帰る。 - closeNewWorkbook()
新しいブックを保存して閉じる。
おわりに
Excelのブック（シートではなく）をデータ入力用の様式みたいに使っている場合、データを入力しては別名で保存、という繰り返しが結構発生すると思う。そんなときに、このクラスを元の様式ブックに搭載してやれば、だいぶラクになると思う。
ただ、もっと簡単なやり方がありそう。
マル中数字をインクリメントする
マル中数字の連番との戦い
１つのブックの中に同じ様式のワークシートが10ヶあって、それぞれに異なるデータを入力していく、という業務が発生した。
ウチの職場では、普通は１シートづつポチポチ入力していくものらしい。
しかし、だ。たいていはせいぜい３シートぐらいまでしか入力することがないらしいんだが、私に割り当てられた業務では約30シート分ぐらい入力せんといかん。
そんなことやってられっかぼけーーーー！
んで、別のシートに約30レコード分のデータを一覧表にしておいて、そこからマクロで転記するようにしようとした。
そしたらね……。
なんと、
データ入力様式のシートの名前が「××①」、「××②」、……みたいになっとる!!!!!!!!
マジかよ……。
一瞬、シート名を変えようかとも思ったんだが、なんかあちこちリンクされているみたいだし、下手にいじくって動かなくなるのもイヤなので、マル中数字をインクリメントして取得する方法を考えた。
マル中数字をインクリメントして取得する
ちょこっとggってみると、こんなのが見つかった。
①から⑳までは、都合良く順番に並んでいるみたい。
これなら、16進数の 8740 から 1 づつインクリメントさせればうまく行きそうだと思った。
文字コードから２バイト文字を取得する方法については、コチラを参考にした。
手順
文字コードから「①」を取得する手順
- 16進数の「8740」をCInt関数で整数に変換する
- 1.で得られた整数をChr関数に渡す
- 「①」が返る
CInt関数が何をやっているのかよく分かっていないのだが、ともかくイミディエイト・ウインドウに
?Chr(CInt((&h8740))
と入力して[Enter]を押すと、
この通り、「①」が取得できている。
あとは、「8740」の部分をインクリメントしていけば、①、②、③、……というふうになるはず。
テストコード
次のようなコードで実験してみる。
リスト１
Public Sub testNumberInCircle()
Dim i As Integer
For i = 0 To 9
Debug.Print Chr(CInt("&h" & 8740 + i))
Next
End Sub
実行結果
無事、①から⑩まで取得することができた。
おわりに
２バイト文字の処理のしかたについては、根が素人だけに分かっていないことが多くて往生する。
今回はShiftJISだったけど、文字コードは他にもあるので、根本から勉強しないといけないなあ。
Private関数（メソッド）でもイミディエイト・ウインドウで動作確認できる
Private関数（メソッド）でもイミディエイト・ウインドウで実行できる
ExcelVBAer (id:x1xy2xyz3) さんからの助言
コチラの記事に、ExcelVBAer (id:x1xy2xyz3) さんからコメントをいただいた。
イミディエイト用の方法で、Private←→Publicという方法の他に、[モジュール名].[関数名]で実行するという方法もありますよ～ 参考まで～
おおっ！ そうだったのか！
……というわけで、早速実験。
実験
このとき作ったcreateNumberFilledByZero関数を使う。
リスト１
Private 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」にしている。
実行
で、イミディエイト・ウインドウに、
?module1.
まで打ち込んでみると、
げげっ！ Intellisenseでお目当てのcreateNumberFilledByZero関数が出てこねえじゃん……！
ちなみに、
module1にはこれだけのプロシージャがあるはずなのです。
んでも、めげずに
?module1.createnumberfilledbyzero(10000,15)
と打ち込んで[Enter]！
結果
おおっ！ ちゃんと実行されとる！
おわりに
……というわけで、ExcelVBAer (id:x1xy2xyz3) さんのおっしゃったとおり、Private関数（メソッド）でも、イミディエイトで動作確認することは可能。
実は、プログラミングの勉強にばかりうつつを抜かしているうちに、本業についての勉強不足が深刻な状態になっていたということに気づきまして……。
このところ、必死でその遅れを取り戻そうとしていたので、ブログの更新もままならず、御礼を申し上げるのが遅くなってしまいました。
ExcelVBAer (id:x1xy2xyz3) さん、ありがとうございました。
ゼロ埋め番号文字列を作る関数を自作した
ゼロ埋め番号を作る関数
調子に乗って関数化
こいつら
をもとに、最大数に応じてゼロ埋め数字の文字列を返す関数を作ってみた。
仕様
書式
createNumberFilledByZero(最大数 , 対象数)
第１引数「最大数」には、ゼロ埋めケタ数の基準になる最大の数を指定する。Long型。たとえば、「1000」を指定すると４ケタのゼロ埋め数字文字列を作ることになる。
第２引数「対象数」には、ゼロ埋めにしたい数字を指定する。Long型。たとえば、第１引数が「1000」のときに、第２引数に「15」を指定すると、「0015」が返ることになる。
返り値
String型。第２引数で指定した数字を、第１引数によって決まるケタ数のゼロ埋め数字文字列にしたものが返る。処理中にエラーがでた場合は、「""」を返す。
ソースコード
リスト１
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)
と書いて実行した結果が、
コチラ。
ゼロ埋め番号ができている。
おわりに
何か意味あるんだろか、コレ？？？
String関数なるものの存在を知った
String関数を使う
前回の
に、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 & "#"
(*)のところですね。
「最大ケタ数－１」個の「0」をつなげた文字列を作るために、１つづつ「0」をつないでいる。
String関数を使えば、これを
Dim n As Integer Dim formatString As String n = Len(CStr(objNum)) - 1 formatString = String(n, "0") & "#" '……(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
(*)のところが変更箇所。
実行すると、
以下省略。
ほれ、ちゃんとゼロ埋めの文字列ができておる。
おわりに
ある程度VBAで意図通りの処理ができるようになってくると、ついつい手持ちの知識だけでどうにかしてしまう、ということになる。
んで、その結果として
ちょっと知識があればカンタンに書ける処理
を、
すんげー力技で解決しちゃう
ということになる。
ある程度自力でコーディングできるようになってきたら、改めてVBA関数一覧なんかを読み直してみる必要があるなあ、と感じました。
久しぶりに入門書を読み直してみるとするか。
それにしても、そもそも
String関数の本来の使い道って何なのだろう……？？？
ゼロ埋め連番を作成する
Format関数の第２引数は、変数でも良かった
ゼロ埋め連番文字列を動的に生成する
たとえば、
こんなマクロを使って大量にファイルを生成するような場合、ファイル名の先頭がゼロ埋め連番になっていると非常に都合が良い。
で、やってみた。
考え方
次のような手順で、適切な桁数のゼロ埋め連番文字列が得られると考えた。
- 個数の桁数を数える
- 「0」を「個数の桁数－１」個連結した文字列を作り、変数に格納する
- 2.でできた文字列に、「#」を連結し、変数に格納する
- 3.まででできた文字列をFormat関数の第２引数とする
コーディング
リスト１
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」）のケタ数（今回は「３」）から１引いた数を変数 n に代入している。
Len関数の引数なんだが、
Len(CStr(objNum))
と、objNumをString型にキャストして渡している。
別に
Len(objNum)
でも良さそうなもんだが、実際そうすると、
こんなふうに、Len関数の返り値が「２」になっている。
イミディエイト・ウインドウに
?Len(105)
とすると、
こんなふうにコンパイル・エラーになる。
ちょっとggってみると、こういうことらしい。
指定された文字列の文字数、または変数の格納に必要な名目上のバイト数を含む整数型の値を返します。
ということは、単純に
Len(objNum)
としたときの返り値はInteger型の変数のバイト数だったってことか。納得。
話を元に戻そう。
(2)からの４行
For i = 1 To n formatString = formatString & "0" Next formatString = formatString & "#"
では、Format関数の第２引数を作っている。
今回の例の場合、３ケタのゼロ埋め数字ができれば良いのだから、Format関数の第２引数は、
"00#"
になれば良い。
今回、数字の個数は「105」。すなわち、３ケタのゼロ埋めになれば良い。(1)の段階で変数 n には「２」が入っているので、まずForループで「"00"」ができて、Forループ終了。
最後に、「#」を付け加えるので、変数formatStringの中身はめでたく「00#」になっている。
これを(3)の
Debug.Print Format(i, formatString)
でFormat関数の第２引数として渡してDebug.Printでイミディエイト・ウインドウに変数 i を出力する。
実行結果
まず最初にこんなふうに表示され、
こんなふうに、ゼロ埋めで数字が出力された。
おわりに
ゼロ埋め連番のケタ数を、対象データの個数に応じて動的に設定できるので、それなりに重宝するかも。
