親ブックから子ブックを量産する

データを変えて親ブックから子ブックを量産するマクロ

子ブック生成部分を切り出す

akashi-keirin.hatenablog.com

の続き。

FileSystemObjectオブジェクトのCopyFileメソッドを使うと、子ブックの生成が簡単にできることが分かったので、いよいよ量産体制に入る。

そのために、子ブック生成部分だけを切り出しておこう。

リスト1
Private Function saveNewWorkbook(ByVal originalFileFullName As String, _
                                 ByVal newFileFullName As String) As Workbook
  Dim fsObject As FileSystemObject    '……(1)'
  Set fsObject = New FileSystemObject
  fsObject.CopyFile Source:=originalFileFullName, _
                    Destination:=newFileFullName
  Set saveNewWorkbook = Workbooks.Open(newFileFullName)    '……(2)'
  Set fsObject = Nothing
End Function

見ての通り、引数を2つ受け取って、新たに生成して保存した子ブックを開いて返すメソッドにした。呼び出され専用なのでPrivateにしている。

まず、(1)からの3行

Dim fsObject As FileSystemObject
Set fsObject = New FileSystemObject
fsObject.CopyFile Source:=originalFileFullName, _
                  Destination:=newFileFullName

は、FileSystemObjectオブジェクトのインスタンスを生成して、CopyFileメソッドを用いる。

これで新しい子ブックが保存される。

次に(2)の

Set saveNewWorkbook = Workbooks.Open(newFileFullName)

では、早速保存した新しい子ブックを開いて返り値にしている。

新しく生成された子ブックに加工したいということが多いと思うので、保存しっぱなしではなく、一旦開いて返り値とするというやり方にした。

第2引数のnewFileFullNameをOpenメソッドの引数にそのまま使えるので楽。

子ブックを量産する

あとは、

  • 親ブックの「個別」シートに「元データ」シートからデータ(笑)を転記する。
  • 一旦親ブックを保存する。
  • 別フォルダにコピーを作成し、子ブックとする。
  • 子ブックを加工する。
  • 子ブックを保存して閉じる。

という処理をForループで回したらよい。

コーディング

スト2
Public Sub main()
  Dim originalWorkbook As Workbook
  Set originalWorkbook = ThisWorkbook
  Dim folderPath As String
  folderPath = originalWorkbook.Path & "\収容所\"  '"
  If Dir(folderPath, vbDirectory) = "" Then MkDir (folderPath)
  Dim orgDataSh As Worksheet
  Set orgDataSh = originalWorkbook.Worksheets("元データ")
  Dim tgtSh As Worksheet
  Set tgtSh = originalWorkbook.Worksheets("個別")
  Dim maxRow As Long
  maxRow = orgDataSh.Cells(Rows.Count, 2).End(xlUp).Row
  Dim newWorkbook As Workbook
  Dim i As Long
  For i = 2 To maxRow
    tgtSh.Range("A1").Value = orgDataSh.Range("B" & i).Value    '……(1)'
    Application.DisplayAlerts = False    '……(2)'
    originalWorkbook.Save    '……(3)'
    Set newWorkbook = saveNewWorkbook(originalWorkbook.FullName, _
                                      folderPath & "子ブック" & Format(i - 1, "0#") & ".xlsm")    '……(4)'
    newWorkbook.Worksheets("元データ").Delete    '……(5)'
    newWorkbook.Close True    '……(6)'
    Application.DisplayAlerts = True    '……(7)'
  Next
  Set originalWorkbook = Nothing
  Set orgDataSh = Nothing
  Set tgtSh = Nothing
  Set newWorkbook = Nothing
End Sub

Forループに入るまでの処理については、説明を省略。オーソドックスな処理ばかりだと思う。

で、Forループの中身だが、

まず(1)の

tgtSh.Range("A1").Value = orgDataSh.Range("B" & i).Value

で、親ブックの「元データ」シートから親ブックの「個別」シートにデータ(笑)を転記。

(2)の

Application.DisplayAlerts = False

でアラート表示を止める。これをやっておかないと、次の処理のときにアラート表示が出てしまう。

(3)の

originalWorkbook.Save

で親ブックを保存。こうしておかないと、データ(笑)の転記が子ブックに反映されない。

ここまで下ごしらえをしておいて、いよいよ(4)の

Set newWorkbook = saveNewWorkbook(originalWorkbook.FullName, _
                                  folderPath & "子ブック" & Format(i - 1, "0#") & ".xlsm")

で子ブックを保存した上で開き、変数newWorkbookに格納。

(5)の

newWorkbook.Worksheets("元データ").Delete

で子ブックの「元データ」シートを削除し、

(6)の

newWorkbook.Close True

で、子ブックを保存して閉じる。

最後に(7)の

Application.DisplayAlerts = True

でアラート表示を元に戻したら、オブジェクト変数を解放して終了。

実行

mainプロシージャを実行すると、

f:id:akashi_keirin:20170812165846j:plain

「収容所」フォルダにちゃんと5つのファイルができている。

f:id:akashi_keirin:20170812165856j:plain

それぞれ「個別」シートのA1セルにデータ(笑)も転記されている。

おわりに

さっそく、

akashi-keirin.hatenablog.com

このとき作ったクラスを修正しようかなあ。

ただ、子ブックもマクロ付きのままってのはちょっと具合が悪いんだよなあ。

@akashi_keirin on Twitter

親ブックから子ブックを生成する

子ブック生成マクロ

親ブックから子ブックを生成する方法

akashi-keirin.hatenablog.com

先日、コチラの記事をうpしたところ、twitterのフォロワーさんから、

FileCopyステートメントでよくね???

的なリプをいただいたのだった。

私自身、

たかがブックの複製を作るぐらいのことでシートを1つ1つコピーした後余分なシートを削除していく

などというやり方は迂遠に過ぎると思っていたところだったので、使ったことなかったけど、FileCopyステートメントとやらを使ってみることにした。

準備

まずは、

f:id:akashi_keirin:20170812143753j:plain

f:id:akashi_keirin:20170812143800j:plain

こんな親ブックを用意した。

やりたい処理は、

  • 「データ」シートB列にあるデータ(笑)を「個別」シートのA1セルに転記する
  • A1セルにデータが書き込まれたブックを「子ブック」として別のフォルダに保存する

というもの。

最終的には、親ブックの「データ」シートにあるB列のデータ(笑)を1つづつ転記しては子ブックとして保存、という風にするのだけれど、とりあえず今回は

1つ目のデータ(「アホ」)を転記した子ブックを保存する

だけにしておく。

処理の手順

次のように考えた。

  1. FileCopyステートメントで親ブックのコピーを別フォルダに作る。
  2. 新しくできた子ブックを開く。
  3. データ(笑)を転記する。
  4. 子ブックを保存して閉じる。

コーディング

次のようにコードを書いた。

リスト1
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

実行

上記のコードを実行すると、

f:id:akashi_keirin:20170812143808j:plain

あっさり一蹴www

(*)のところでエラーが出ていた。

ちょいとggってみると、コチラのブログがヒット。

それによると、

ExcelVBAでファイルをコピーする際に使用する"FileCopy"は開かれているファイルをコピーすることはできません。

とのこと。

で、

コピー元ファイルが閉じている(使用されていない)ことを保証できない場合は、ExcelVBAの"FileCopy"を使用せずに"Scripting.FileSystemObject"の"CopyFile" を使用します。

ということ。なるほど、FileSystemObjectオブジェクトのCopyFileメソッドを使えばいいわけか。

コードの修正

次のように修正。ちなみに、CreateObjectはあんまり使いたくないので、ツール→参照設定で「Microsoft Scripting Runtime」にチェックを入れてNewできるようにしといた。

スト2
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)からの3行、

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

でデータ(笑)を転記。

後は、「元データ」シートを削除して保存して閉じているだけ。

実行

f:id:akashi_keirin:20170812143817j:plain

このように、指定したフォルダに子ブックが保存されている。

f:id:akashi_keirin:20170812143853j:plain

子ブックを開くと、無事にデータ(笑)が転記されている。

おわりに

子ブックの生成については、ずいぶん簡単に書くことができた。

ただ、このやり方で困るのは、子ブックがxlsmのままになってしまうこと。

たぶん、前回の記事id:imihito さんからいただいたコメントのやり方(SaveCopyAsメソッドを使う)でも同じことになると思う。

まあ、ちょっと調べたらできそうな気もするけど、今は本業がいっぱいいっぱいなので、それはまた別の機会に……。

@akashi_keirin on Twitter

Excelのブックを複製するクラス

子ブックを生み出すクラス

元のブックを開いたままでコピーを作成する

元のブックのシートにデータを入力しては別名で保存して、同じ様式でデータの異なるたくさんのブックを作りたいというときがある。

Worksheetオブジェクトの場合なら、Copyメソッドがあるので簡単にできるが、WorkbookオブジェクトにはCopyメソッドがないので、上記のようなことがしたいときに、不便だなあと思っていた。

ブックの複製を作るときの考え方

  1. WorkbooksコレクションのAddメソッドで新しいブックを作る。
  2. 新しくできたブックの先頭に、元のブックのシートをケツから順に挿入していく。
  3. 新しいブックは、元のブックのシート+デフォルトのシートの状態になっているので、デフォルトのシートをケツから順に削除していく。
  4. 新ブックに新しい名前を付ける。
  5. 新ブックの各セルの参照元を新ブックに改める。
  6. 新ブックにデータを書き込むなどの処理を施す。
  7. 新ブックを保存して閉じる。

この手順でやってみた。

子ブックを生み出すクラスの作成

ソースコードを示す。

リスト1 クラスモジュール

※オブジェクト名は「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

新しくできたブックのシート名を変更している。こうしておかないと、最終的にできあがったブックのシート名が、

f:id:akashi_keirin:20170806093002j:plain

こんなふうになってしまうし、

f:id:akashi_keirin:20170806093012j:plain

数式の参照先も更新されなくなってしまう。

※なぜこうなるのかは、自分で考えてみてください。

(3)の

For i = originalWorkbook_.Worksheets.Count To 1 Step -1
  originalWorkbook_.Worksheets(i).Copy before:=newWorkbook_.Worksheets(1)
Next

では、WorksheetオブジェクトのCopyメソッドを使って新しいブックの先頭に、元のブックのシートをケツから順に挿入している。こうすることで、新しいブックは、先頭から元のブックのシートが順番通りに並び、その後ろにデフォルトのシートが並んでいる状態になる。2010以前だとデフォルトのシートが3つ、2013以降だとデフォルトのシートは1つだけですね。

で、次は(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

は、新しいブックを保存して閉じるためのメソッド。

ただし、新しいブックを生成してもいないのにコイツを実行されたら困るので、(*)からの5行、

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メソッド実行し忘れを防ぐためなのですが、これで良いのでしょうか……???

実行 その1

次のコードで実験してみる。

スト2 標準モジュール
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にしているので、単純に元のブックを名前を変えつつ3つ複製するだけのコード。

実行結果

f:id:akashi_keirin:20170806093047j:plain

「収容所」フォルダに3つのブックができている。

f:id:akashi_keirin:20170806093026j:plain

こんなふうに、参照先も新しいブックになっている。

実行 その2

今度は、次のコードで実行してみる。

リスト3 標準モジュール
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のA3セルに、自身のファイル名を書き込むようにしている。

実行結果

f:id:akashi_keirin:20170806093108j:plain

「収容所」フォルダ内に3つのブックができている。

f:id:akashi_keirin:20170806093056j:plain

Sheet3のA3セルにはファイル名が書き込まれている。

まとめ

NewWorkbookCreatorクラス 仕様
フィールド
  • newWorkbook(Workbook型。新しくできたブックを格納する。)
メソッド
  • createNewWorkbook(String newFullName,
    [Boolean enableToChangeLink],
    [Boolean enableToChangeNewWorkbook])
    元のブックを複製し、引数newFullNameをフルパスとして保存する。
    引数enableToChangeLinkがTrueならば、新しいブックの数式等の参照先は新しいブックになる。
    引数enableToChangeNewWorkbookがTrueならば、新しいブックを保存して閉じる前に一旦メソッドの呼び出し元に帰る。
  • closeNewWorkbook()
    新しいブックを保存して閉じる。

おわりに

Excelのブック(シートではなく)をデータ入力用の様式みたいに使っている場合、データを入力しては別名で保存、という繰り返しが結構発生すると思う。そんなときに、このクラスを元の様式ブックに搭載してやれば、だいぶラクになると思う。

ただ、もっと簡単なやり方がありそう。

@akashi_keirin on Twitter

マル中数字をインクリメントする

マル中数字の連番との戦い

1つのブックの中に同じ様式のワークシートが10ヶあって、それぞれに異なるデータを入力していく、という業務が発生した。

ウチの職場では、普通は1シートづつポチポチ入力していくものらしい。

しかし、だ。たいていはせいぜい3シートぐらいまでしか入力することがないらしいんだが、私に割り当てられた業務では約30シート分ぐらい入力せんといかん。

そんなことやってられっかぼけーーーー!

んで、別のシートに約30レコード分のデータを一覧表にしておいて、そこからマクロで転記するようにしようとした。

そしたらね……。

なんと、

データ入力様式のシートの名前が「××①」、「××②」、……みたいになっとる!!!!!!!!

マジかよ……。

一瞬、シート名を変えようかとも思ったんだが、なんかあちこちリンクされているみたいだし、下手にいじくって動かなくなるのもイヤなので、マル中数字をインクリメントして取得する方法を考えた。

マル中数字をインクリメントして取得する

ちょこっとggってみると、こんなのが見つかった。

f:id:akashi_keirin:20170805195502j:plain

①から⑳までは、都合良く順番に並んでいるみたい。

これなら、16進数の 8740 から 1 づつインクリメントさせればうまく行きそうだと思った。

文字コードから2バイト文字を取得する方法については、コチラを参考にした。

手順

文字コードから「①」を取得する手順

  1. 16進数の「8740」をCInt関数で整数に変換する
  2. 1.で得られた整数をChr関数に渡す
  3. 「①」が返る

CInt関数が何をやっているのかよく分かっていないのだが、ともかくイミディエイト・ウインドウに

?Chr(CInt((&h8740))

と入力して[Enter]を押すと、

f:id:akashi_keirin:20170805195504j:plain

この通り、「①」が取得できている。

あとは、「8740」の部分をインクリメントしていけば、①、②、③、……というふうになるはず。

テストコード

次のようなコードで実験してみる。

リスト1
Public Sub testNumberInCircle()
  Dim i As Integer
  For i = 0 To 9
    Debug.Print Chr(CInt("&h" & 8740 + i))
  Next
End Sub

実行結果

f:id:akashi_keirin:20170805195517j:plain

無事、①から⑩まで取得することができた。

おわりに

2バイト文字の処理のしかたについては、根が素人だけに分かっていないことが多くて往生する。

今回はShiftJISだったけど、文字コードは他にもあるので、根本から勉強しないといけないなあ。

@akashi_keirin on Twitter

Private関数(メソッド)でもイミディエイト・ウインドウで動作確認できる

Private関数(メソッド)でもイミディエイト・ウインドウで実行できる

ExcelVBAer (id:x1xy2xyz3) さんからの助言

akashi-keirin.hatenablog.com

コチラの記事に、ExcelVBAer (id:x1xy2xyz3) さんからコメントをいただいた。

イミディエイト用の方法で、Private←→Publicという方法の他に、[モジュール名].[関数名]で実行するという方法もありますよ~ 参考まで~

おおっ! そうだったのか!

……というわけで、早速実験。

実験

このとき作ったcreateNumberFilledByZero関数を使う。

リスト1
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.

まで打ち込んでみると、

f:id:akashi_keirin:20170805185924j:plain

げげっ! Intellisenseでお目当てのcreateNumberFilledByZero関数が出てこねえじゃん……!

ちなみに、

f:id:akashi_keirin:20170805190015j:plain

module1にはこれだけのプロシージャがあるはずなのです。

んでも、めげずに

?module1.createnumberfilledbyzero(10000,15)

と打ち込んで[Enter]!

結果

f:id:akashi_keirin:20170805190024j:plain

おおっ! ちゃんと実行されとる!

おわりに

……というわけで、ExcelVBAer (id:x1xy2xyz3) さんのおっしゃったとおり、Private関数(メソッド)でも、イミディエイトで動作確認することは可能。

実は、プログラミングの勉強にばかりうつつを抜かしているうちに、本業についての勉強不足が深刻な状態になっていたということに気づきまして……。

このところ、必死でその遅れを取り戻そうとしていたので、ブログの更新もままならず、御礼を申し上げるのが遅くなってしまいました。

ExcelVBAer (id:x1xy2xyz3) さん、ありがとうございました。

@akashi_keirin on Twitter

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

ゼロ埋め番号を作る関数

調子に乗って関数化

こいつら

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