ブックを閉じて別フォルダに移動する(Excel)

f:id:akashi_keirin:20180610191139p:plain

Excelブックを移動する

この時期、あちこちから集めたデータ(笑)を集約するという作業が頻発する。

この手の業務は、VBAを使って瞬殺する私にとっては痛くも痒くもない。しかしながら、職場全体で見ると、この手のアホみたいな作業に膨大な時間を費やすというのが多数派。

別に人助けというわけではないけれど、最近は進んで他人のためにコードを書いている。本業の大半がクソつまらないものなので、却ってストレス解消にもなるし。

ブックを閉じて別のフォルダへ移す

近況報告はこのぐらいにして本題。

あちこちから集めたデータ(笑)を集約する、という作業に必ずつきまとうのが、

ブックを閉じる→別のフォルダに移動する

という操作。

集まってくるExcelブックが、ろくに下処理をしていない(データの入力規則を当てたり、ブックやシートの保護をかけたり、といった処理をろくにしていない)ものなので、フルオートにするよりも、

一つ一つのブックを開いて確認するところまでは手動、集約用シートへの転記以降は自動

にする方が安全なんである。

よって、「ブックを閉じる→別のフォルダへ移動する」という操作はやたら出てくるのであった。

別にその都度書いてもそれほどメンドウでもないんだけれど、メソッド化してみたというわけ。

ブックを閉じて別フォルダに移動するメソッド

リスト1 標準モジュール
Public Function moveBook(ByVal targetBook As Workbook, _
                         ByVal oldFullPath As String, _
                         ByVal newFullPath As String, _
                Optional ByVal canSaveChanges As Boolean = False) As Boolean '……(1)'
On Error GoTo errorHandler
  Application.DisplayAlerts = False    '……(2)'
  Call targetBook.Close(SaveChanges:=canSaveChanges)    '……(3)'
  Name oldFullPath As newFullPath    '……(4)'
  moveBook = True    '……(5)'
errorHandler:    '……(6)'
  Application.DisplayAlerts = True
  If Not moveBook Then moveBook = False
End Function

まず(1)の

Public Function moveBook(ByVal targetBook As Workbook, _
                         ByVal oldFullPath As String, _
                         ByVal newFullPath As String, _
                Optional ByVal canSaveChanges As Boolean = False) As Boolean

で引数と返り値を設定。

第1引数targetBookは、処理対象のWorkbookオブジェクト。

第2引数oldFullPathは、処理対象ブックの移動前のフルパス。

第3引数newFullPathは、処理対象ブックの移動後のフルパス。

第4引数canSaveChangesは、処理対象ブックを閉じるときに保存するかどうか。通常、転記処理後に上書き保存などする必要はないと思うので、省略可にして既定値をFalseにしてある。

返り値はBoolean型。無事ブックの移動が出来たらTrue、失敗したらFalseを返す。

コード自体はアホみたいに簡単なので、特に説明の必要はないと思うが、一応簡単に。

(2)の

  Application.DisplayAlerts = False

で、一旦警告表示を止める。通常、転記処理では処理対象ブックに変更を加えることなどないと思うが、今回手伝った事案で処理対象ブックに加工しないと集約できない、というケースがあったのでw

次に(3)の

Call targetBook.Close(SaveChanges:=canSaveChanges)

で処理対象ブックを閉じる。

targetBook.Close SaveChanges:=canSaveChanges

でも良いと思うが、引数がハダカになるのはやっぱりキモチワルイので……。

「ママー、裸じゃイヤ!」みたいな感じです。

(4)の

Name oldFullPath As newFullPath

はおなじみNameステートメント

「旧フルパス」と「新フルパス」の順序がよくごっちゃになる(いや、「As」の意味を考えたら割とすぐに分かるんですけどね!)ので、メソッドの中に閉じ込めてしまったわけですよ。

そもそも、なんで「As」なんているんでしょうねえ? 「Name 目的語 補語」で「○○を××と名づける」なんだから、別にName [OldFullName], [NewFullName]でいいと思うんですけど。

(4)が無事実行できたら(エラーにならなければ)、無事フォルダ移動が終わったということなので、(5)の

moveBook = True

で返り値をTrueにする。

普通だったら、ここで即returnすりゃいいってもんだが、

Application.DisplayAlerts = True

を2回も書きたくないので、エラーキャッチ用のブロックである(6)からの3行を

errorHandler:
  Application.DisplayAlerts = True
  If Not moveBook Then moveBook = False

こんなふうにした。

途中でエラーが出た場合も、エラーが出なかった場合も、このブロック内を実行するようにした。

かといって、すでにブックの移動が無事に終わった場合にFalseを返されてはたまらないので、

If Not moveBook Then moveBook = False

この時点で返り値がTrueでない場合にのみFalseを返すようにした。

おわりに

まあ、メリットといえば、NameステートメントApplication.DisplayAlertsまわりをラップしてメインのコードから隔離できることぐらいですけど。

君は[Ctrl]+[J]というショートカットキーを知っていたか(VBE)

[Ctrl]+[J]というショートカットキー

[Ctrl]+[J]の働き

Twitterで、thom (id:t-hom) さんが教えてくださった。曰く、

識別子はCtrl+Jで入力候補でる

と。

え? そ、そうなんすか???

というわけでちょっとやってみた。

変数名の入力中に[Ctrl]+[J]

f:id:akashi_keirin:20180610175303j:plain

こんなふうに、変数targetRangeが宣言済みの状態で、tarまで入力して、[Ctrl]+[J]をポチッと押してみる。

f:id:akashi_keirin:20180610175314j:plain

うおお! ほんまや!

おわりに

「(゚Д゚)ハァ? そんなことも知らなかったの???」とか、笑わば笑え。

変数名を役割明示的にするために、変数名がむやみに長くなりがちなので、このワザを覚えたのは大きい。

カーソルを任意の位置に置く(Word)

f:id:akashi_keirin:20180610173412j:plain

カーソルを任意の位置に置く

たぶんWord2010のバグだと思うのだけれど、均等割付を施したところに差込フィールドがあると、差し込まれた後に字幅がおかしくなる。

職場のPCでしか遭遇しない症状なので、画像でお見せできないんだけれど、データが差し込まれた瞬間、字幅が異様に縮まってそのままになってしまう。

特に困るのは、

akashi-keirin.hatenablog.com

これを使ってレコードごとにドキュメントを作成したとき。

差し込むデータの文字数によって、字幅が広がったり狭まったりして、ガタガタになってしまう。

できあがったものを開いて、均等割付部分にカーソルを当てると元に戻るのだが、いちいち開いてはクリック、とかやっていたのでは、何のために自動化したのか分からない。

そこで、作成する文書に応じてRangeプロパティを使って

targetDocument.Range(1,1).Select

みたいなのを書いていた。

ところが、均等割付を施す場所なんて文書によってまちまちだから、テンプレートになる文書の均等割付の場所に応じてその都度指定するRangeプロパティの引数を調整する、という実にアホなことになっている。

Selection.GoToメソッド

「○ページ目の○行目の○文字目にカーソルを置く」ようなメソッドを作れば、少しは指定しやすくなると思って調べてみると、Selection.GoToメソッドというものを見つけた。

例によってMSDNのSelection.GoToメソッドのページによると、

指定した項目の直前の文字位置にカーソルを移動します。

という実に素っ気ない記述。引数が4種類あるけれど、それらは、

パラメータ
What

省略可能です。オブジェクト型 (Object) の値を指定します。選択範囲の移動先の項目の種類を指定します。使用できる定数は、WdGoToItem 列挙型の定数のいずれかです。

Which

省略可能です。オブジェクト型 (Object) の値を指定します。選択範囲の移動先を指定します。使用できる定数は、WdGoToDirection 列挙型の定数のいずれかです。

Count

省略可能です。オブジェクト型 (Object) の値を指定します。文書内の項目の番号を指定します。既定値は 1 です。

正の値のみ有効です。指定範囲または選択範囲より前にある項目を指定するには、引数 Which として wdGoToPrevious を使用し、Count の値を指定します。

Name

省略可能です。オブジェクト型 (Object) の値を指定します。引数 What に wdGoToBookmark、wdGoToComment、wdGoToField、wdGoToObject のいずれかを指定した場合、この引数は名前を指定します。

とのこと。

ちなみに、WdGoToItem列挙体については、同じくMSDNのWdGoToItem列挙体のページを、WdGoToDirection列挙体については、MSDNのWdGoToDirection列挙体のページをご覧ください。

○ページ○行目○文字目にカーソルを置くFunction

とりあえず、次のようなFunctionを作ってみた。

リスト1 標準モジュール
Public Function setCursor(ByVal targetPage As Long, _
                          ByVal targetLine As Long, _
                          ByVal targetCharacter As Long) As Boolean    '……(1)'
  If targetPage <= 0 Then GoTo Finalizer
  If targetLine <= 0 Then GoTo Finalizer
  If targetCharacter <= 0 Then GoTo Finalizer
On Error GoTo Finalizer
  Call Selection.GoTo(What:=wdGoToPage, _
                      Which:=wdGoToAbsolute, _
                      Count:=targetPage)    '……(2)'
  If targetLine = 1 Then    '……(3)'
  Else
    Call Selection.GoTo(What:=wdGoToLine, _
                        Which:=wdGoToRelative, _
                        Count:=targetLine - 1)
  End If
  Call Selection.MoveRight(Unit:=wdCharacter, _
                           Count:=targetCharacter - 1, _
													 Extend:=wdMove)    '……(4)'
  setCursor = True
  Exit Function
Finalizer:
  setCursor = False
End Function

まず、(1)の

Public Function setCursor(ByVal targetPage As Long, _
                          ByVal targetLine As Long, _
                          ByVal targetCharacter As Long) As Boolean

で引数と返り値の設定。

第1引数targetPageでページ数、

第2引数targetLineで何行目か、

第3引数targetCharacterで何文字目かを渡す。

返り値はBoolean型。成功したらTrue、失敗したらFalseを返す。

(2)の

Call Selection.GoTo(What:=wdGoToPage, _
                    Which:=wdGoToAbsolute, _
                    Count:=targetPage)

では、Selection.GoToメソッドを用いてまずはページ移動。

引数WhatwdGoToPageを指定しているのでページ単位の移動、引数WhichwdGoToAbsoluteを指定しているので、文書全体の引数Countページ目に移動することになる(と思う)。

次は行移動。

(3)の

If targetLine = 1 Then
Else
  Call Selection.GoTo(What:=wdGoToLine, _
                      Which:=wdGoToRelative, _
                      Count:=targetLine - 1)
End If

では、同じようにSelection.GoToメソッドを用いているが、今度はIfを用いている。

実は、にもあるように、Countの既定値が1で、ここが0になると、1と見なされるっぽいのだ。

従って、引数targetLine1(つまり○ページ目の1行目というとき)は、何もしない、ということになる。何もしない、ということを明示するためにあえてこのような書き方にした次第。

(2)実行直後にカーソルは引数targetPage目の先頭にあるので、引数WhichwdGoToRelativeにした。

このとき、Count1だと2行目先頭にカーソルが移動するようなので、targetLine - 1としている。

あとは(4)の

Call Selection.MoveRight(Unit:=wdCharacter, _
                         Count:=targetCharacter - 1, _
												 Extend:=wdMove)

Selection.MoveRightメソッドでtargetCharacter字目にカーソルを移動する。

Selection.MoveRightメソッドについては、MSDNのSelection.MoveRightメソッドのページをどうぞ。

おわりに

実は、未だにWordのSelectionというオブジェクトがよく分かっていない。っていうか、Wordのオブジェクトモデルそのものがよく分かっていない。きちんと勉強したいのだけれど、現状本業の勉強が忙しくて、Wordのオブジェクトモデルの勉強に手が回っていない。

もどかしいなあ。

Wordの「スタイル」をVBAで操作する(3) (Word)

「標準」スタイルのフォントを変更するメソッド

前回

akashi-keirin.hatenablog.com

のつづき。

一発で「標準」スタイルのフォント設定を変更することができるようなマクロを作ってみる。

リスト1 標準モジュール
'///標準スタイルのフォントを設定する'
Public Sub setFontForStandardStyle(ByVal fontName As String, _
                                   Optional ByVal isFarEast As Boolean = False)
  Dim styleIndex As Long
  styleIndex = getStandardStyleIndex(ThisDocument)    '……(1)'
  If styleIndex = -1 Then Exit Sub    '……(6)'
  With ThisDocument
    Dim fontBeforeChange As String
    If isFarEast Then    '……(7)'
      fontBeforeChange = .Styles(styleIndex).Font.NameFarEast
    Else
      fontBeforeChange = .Styles(styleIndex).Font.Name
    End If
  End With
On Error GoTo errorHandler
  With ThisDocument.Styles(styleIndex).Font    '……(8)'
    If isFarEast Then .NameFarEast = fontName: Exit Sub
    If Not isFarEast Then .Name = fontName: Exit Sub
  End With
errorHandler:
  With ThisDocument    '……(9)'
    If isFarEast Then
      .Styles(styleIndex).Font.NameFarEast = fontBeforeChange
    Else
      .Styles(styleIndex).Font.Name = fontBeforeChange
    End If
  End With
End Sub
'「標準」スタイルのインデックス番号を取得する'
Private Function getStandardStyleIndex( _
                   ByVal targetDocument As Document) As Long    '……(2)'
  With targetDocument
    Dim i As Long
    For i = 1 To .Styles.Count    '……(3)'
      With .Styles(i)
        If .NameLocal = "標準" Then _
          getStandardStyleIndex = i: Exit Function    '……(4)'
      End With
    Next
  End With
  getStandardStyleIndex = -1    '……(5)'
End Function

メインはsetFontForStandardStyleプロシージャ。途中getStandardStyleIndexプロシージャを呼び出す、という形になっている。

まず、いきなり(1)の

styleIndex = getStandardStyleIndex(ThisDocument)

getStandardStyleIndexを呼び、返り値をstyleIndexに突っ込む。

getStandardStyleIndexプロシージャは、ドキュメントの「標準」スタイルのインデックス番号を割り出すFunction。

さっそく中身を見ていく。

まず(2)の

Private Function getStandardStyleIndex( _
                   ByVal targetDocument As Document) As Long

は、おなじみの引数設定と返り値設定。

対象のDocumentを受けとって、「標準」スタイルのインデックスを返す。

内部では、(3)からの5行(実質4行)

For i = 1 To .Styles.Count
  With .Styles(i)
    If .NameLocal = "標準" Then _
      getStandardStyleIndex = i: Exit Function    '……(4)'
  End With
Next

で、For ~ Nextを用いて「標準」スタイルのインデックス番号を割り出す。

(targetDocument).Styles(i)で取り出した一つ一つのDocument.Styleオブジェクトについて、(4)の

If .NameLocal = "標準" Then getStandardStyleIndex = i: Exit Function

NameLocalプロパティが「標準」かどうかを調べ、「標準」だったらその時点でのiの値をreturnする、というもの。

もし一致しなければ(異常事態だけれど)、Forループから抜けることになるので、(5)の

getStandardStyleIndex = -1

で「-1」(あり得ない値)をreturnする。

処理がsetFontForStandardStyleプロシージャに戻ってくると、すかさず(6)の

If styleIndex = -1 Then Exit Sub

で返り値チェック。

-1」が返っていたとしたら異常事態なので、何もせずにExitする。

(6)を無事通過したら、あとはメインの処理へ。

……とその前に下ごしらえを。(7)からの5行

If isFarEast Then    '……(7)'
  fontBeforeChange = .Styles(styleIndex).Font.NameFarEast
Else
  fontBeforeChange = .Styles(styleIndex).Font.Name
End If

で、引数isFarEastの値に応じて処理を分ける。

isFarEastTrueだったら、現時点の日本語用フォントの名前を変数fontBeforeChangeにぶち込んでおく。

逆に、isFarEastFalseだったら、現時点の英数字用フォントの名前を変数fontBeforeChangeにぶち込んでおく。

この後の処理でエラーが出るなどして実行できなかったときに、フォント設定を元に戻すため。

やっとメインの処理。(8)からの4行

With ThisDocument.Styles(styleIndex).Font    '……(8)'
  If isFarEast Then .NameFarEast = fontName: Exit Sub
  If Not isFarEast Then .Name = fontName: Exit Sub
End With

で、Document.Style.FontオブジェクトのNameFarEastまたはNameプロパティを設定する。

このとき、存在しないフォント名を渡したとかでエラーが出たら、(9)からの7行

With ThisDocument
  If isFarEast Then
    .Styles(styleIndex).Font.NameFarEast = fontBeforeChange
  Else
    .Styles(styleIndex).Font.Name = fontBeforeChange
  End If
End With

でフォント設定を元に戻すようにした。

使ってみる

getStandardStyleIndexプロシージャ

まずは、getStandardStyleIndexプロシージャを使ってみる。

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

?WdCommon.getStandardStyleIndex(ThisDocument)

と入力して[Enter]。

ちなみに、

akashi-keirin.hatenablog.com

このときにも紹介したように、Privateメソッドであっても、[モジュール名].[メソッド名]とすれば、イミディエイト・ウィンドウで実行することができる。

f:id:akashi_keirin:20180513162135j:plain

ちゃんと「194」が返っている。

setFontForStandardStyleプロシージャ

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

スト2 標準モジュール
Public Sub testSetFontForStandardStyle()
  Call setFontForStandardStyle("MS ゴシック", True)
End Sub

setFontForStandardStyleの引数fontNameに「"MS ゴシック"」を、引数isFarEastに「True」を渡しているだけ。意図どおりならば、日本語用フォントが「MS ゴシック」になるはず。

実行結果

f:id:akashi_keirin:20180513162144j:plain

この状態で実行すると、

f:id:akashi_keirin:20180513162153j:plain

こうなる。意図どおり。

このマクロをクイック アクセス ツール バーにでも仕込んでおいたら、1クリックで「標準」スタイルのフォント設定を変えることができるし、Dir関数、Documents.Openメソッドと組み合わせたらフルオートでフォルダ内一括変換とかもできそう。あんまり需要はないだろうけれど。

追記

コードを修正しました。

スト2 標準モジュール
'///標準スタイルのフォントを設定する'
Public Sub setFontForStandardStyle(ByVal fontName As String, _
                                   Optional ByVal isFarEast As Boolean = False)
  Dim standardStyle As Style
  Set standardStyle = getStandardStyle(ThisDocument)
  If standardStyle Is Nothing Then Exit Sub
  With standardStyle.Font
    Dim fontBeforeChange As String
    If isFarEast Then
      fontBeforeChange = .NameFarEast
    Else
      fontBeforeChange = .Name
    End If
  End With
On Error GoTo errorHandler
  With standardStyle.Font
    If isFarEast Then .NameFarEast = fontName: Exit Sub
    If Not isFarEast Then .Name = fontName: Exit Sub
  End With
errorHandler:
  With standardStyle.Font
    If isFarEast Then
      .NameFarEast = fontBeforeChange
    Else
      .Name = fontBeforeChange
    End If
  End With
End Sub
'「標準」スタイルを取得する'
Private Function getStandardStyle( _
                   ByVal targetDocument As Document) As Style
  With targetDocument
    Dim targetStyle As Style
    For Each targetStyle In .Styles
      If targetStyle.NameLocal = "標準" Then _
          Set getStandardStyle = targetStyle: Exit Function
    Next
  End With
  Set getStandardStyle = Nothing
End Function

直接Styleオブジェクトを取得する形にしました。

Wordの「スタイル」をVBAで操作する(2) (Word)

「標準」スタイルのフォントを変える

前回

akashi-keirin.hatenablog.com

のつづき。

ウチの環境では、Document.Styles(194)で「標準」スタイルにアクセスできるのだった。

Style.Fontオブジェクト

MSDN Dev Centerの「Style Members (Word)」によると、フォントの設定はFontプロパティにアクセスしてFontオブジェクトを取得して操作するっぽい。

で、Fontオブジェクトのページ(MSDN Dev Centerの「Font Members (Word)」)を見てみると、フォント名を設定/取得するっぽいものとして

  • Name
  • NameAscii
  • NameBi
  • NameFarEast
  • NameOther

この5種があった。

詳しくはリンク先の記載内容をお読みいただくとして、基本的にはNameプロパティ(英数字用)、NameFarEastプロパティ(日本語用)を設定すればいいっぽい。

イミディエイト・ウィンドウで確認する

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

?thisdocument.Styles(194).Font.NameFarEast

および、

?thisdocument.Styles(194).Font.Name

と入力して確認してみる。

f:id:akashi_keirin:20180513082235j:plain

この通り、NameFarEastの方は「MS 明朝」、Nameの方は「Century」が返った。

Word本体の方に戻って、スタイル ギャラリーで確認してみると、

f:id:akashi_keirin:20180513082244j:plain

ぴったり一致している。

つまり、Document.Style.Font.NameFarEastで日本語用フォント、Document.Style.Font.Nameで英数字用フォントを設定することができるということだ。

「標準」スタイルのフォント設定をVBAで変えてみる

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

thisdocument.Styles(194).Font.NameFarEast = "MS ゴシック"

と入力して[Enter]してみる。

f:id:akashi_keirin:20180513082255j:plain

f:id:akashi_keirin:20180513082304j:plain

意図どおりの結果になっている。

これで面倒だった作業が1クリックでできるめどが立った。

akashi-keirin.hatenablog.com

Wordの「スタイル」をVBAで操作する(Word)

Wordの「スタイル」をVBAで操作する

ウチの職場には、書類の英数字は等幅という謎ルールがある。

まあ、位置が揃わないのが嫌なのはなんとなく分かる。

ただ、「スタイル」という機能を知らずにWordを使っている人がほとんど(目測で9割以上)なので、

文書作成→文書全体を選択→フォントを「MS 明朝」に変更

という

最高にロックなイカしたやり方

をする人がほとんど。

っていうか、ドヤ顔で

最後に全体を選択して「MS 明朝」に変えたら楽やないか!

と推奨する人までいる(実話)。

そんなわけで、ウチで量産されるWord文書は、「標準」スタイルの英数字フォントの設定がデフォルトの「Century」のままなのに、英数字の箇所はことごとく「MS 明朝(またはゴシック)」という最高にクールなことになっているのである。

スタイルを変更するのはめんどくさい

書類なんかは、前年度のものを使い回すことが多いので、当然「標準スタイル」の英数字フォントがCenturyのままなのに、英数字のところが「MS 明朝」に無理矢理変えられているだけの文書を扱う機会が多い。っていうか、ほぼそんな感じ。

したがって、「標準」スタイルのフォント設定を変更するという作業が発生するのだが、正攻法でやると結構めんどくさい。

「標準」スタイルの英数字フォント設定を変更する手順
  1. 「ホーム」タブの「スタイル ギャラリー」で「標準」を右クリック
  2. 「変更」をクリック
  3. 「書式」ボタンをクリック
  4. 「フォント」をクリック
  5. 「フォント」タブの「英数字用のフォント」のドロップダウンリストから「(日本語用と同じフォント)」を選択
  6. [OK]をクリック
  7. [OK]をクリック

と、実に7段階もの作業が生ずるのである!

こういう単純作業はマクロ化するに限る。

Document.Styleオブジェクト

ちょいと調べてみると、「スタイル」そのものは、Documentオブジェクトの配下にあるStylesコレクションの一員で、Styles(Indexで取得できるということはすぐに分かった。

【参考】MSDN デベロッパー センター「Styles オブジェクト (Word)」

Styleオブジェクトのメンバについては、MSDN デベロッパー センター「Style Members (Word)」に掲載されているが、英語版しかないみたい。

「標準」スタイルのインデックス番号を割り出す

オブジェクト ブラウザーで、Styleオブジェクトのメンバを列挙してみる。

f:id:akashi_keirin:20180513072013j:plain

どうもNameLocalというやつがスタイルの日本語名を指すっぽい(なんでコイツだけ変なアイコンなんだろ?)。

MSDN デベロッパー センター「Style Members (Word)」での説明も、

Returns the name of a built-in style in the language of the user. Read/write
String.

となっている。「ユーザーの言語での組み込みスタイル名を返す」ぐらいか。

で、次のコードで「標準スタイル」のインデックス番号を割り出すことを試みた。

リスト1 標準モジュール
Public Sub test()
  Dim s As Style
  Dim cnt As Long
  cnt = 1
  For Each s In ThisDocument.Styles
    Debug.Print cnt & vbTab & s.NameLocal
    cnt = cnt + 1
  Next
End Sub

For EachStylesコレクションを巡回して、1から順に番号を付けてスタイル名をイミディエイトに表示するだけのコード。

別にFor Eachじゃなくても、普通のFor文でも書ける(For i = 1 To ThisDocument.Styles.Countにする)。

[F8]連打でステップ実行を繰り返すと、

f:id:akashi_keirin:20180513072022j:plain

発見!

ウチの環境では、「194」というのが「標準」スタイルのインデックス番号らしい。

Document.Styles(194)で「標準」スタイルオブジェクトにアクセスできるので、あとはオブジェクトの操作の仕方さえ分かったらマクロ化が可能になる。

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

VirtualTableクラスへのメソッドの追加[getFilteredArrayメソッド]

VirtualTableクラス続報

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

指定した条件を満たす配列を返すメソッド

任意の列の値が指定した値であるレコードだけを格納した配列を返すメソッドを作ってみた。

ひとまずコードを載っけておく。

getFilteredArrayメソッドのコード

リスト1-1 クラスモジュール
'///2次元配列(引数1)から任意の列(引数2)の値が、任意の値(引数3)である'
'   要素だけを抽出した2次元配列を返す'
Public Function getFilteredArray( _
                  ByRef targetArray As Variant, _
                  ByVal targetColumn As Long, _
                  ByVal targetValue As Variant) As Variant    '……(1)'
  '///ガード節。未初期化ならエラーを吐く。'
  If Not isInitialized_ Then _
    Call catchException(thrownException10001)    '……(2)'
  '///ガード節。引数1が2次元配列でなかったらエラーを吐く。'
  If getArrayDimension(targetArray) <> 2 _
    Then Call catchException(thrownException10002)    '……(3)'
On Error GoTo errorHandler
  Dim returnArray As Variant    '……(4)'
  ReDim returnArray(1 To 1, 1 To UBound(targetArray, 2))
  Dim i As Long
  Dim j As Long
  Dim n As Long    '……(5)'
  n = 1
  For i = LBound(targetArray, 1) To UBound(targetArray, 1)    '……(6)'
    If targetArray(i, targetColumn) = targetValue Then
      '2要素目以降は、配列を拡張してから要素を追加する'
      If n > 1 Then returnArray = _
                      expand2DimentionalArray(returnArray, 1)    '……(7)'
      For j = LBound(targetArray, 2) To UBound(targetArray, 2)    '……(8)'
        '各列の要素を追加'
        returnArray(n, j) = targetArray(i, j)
      Next
      n = n + 1    '……(9)'
    End If
  Next
  isFiltered_ = True
  filteredArray_ = returnArray    '……(10)'
  getFilteredArray = returnArray: Exit Function
errorHandler:
  '///配列の作成に失敗してエラーが出たら、既存のfilteredArray_を返す'
  getFilteredArray = filteredArray_
End Function

まずは(1)の

Public Function getFilteredArray( _
                  ByRef targetArray As Variant, _
                  ByVal targetColumn As Long, _
                  ByVal targetValue As Variant) As Variant

で引数と返り値の設定。

冒頭のコメントにもあるように、
第1引数targetArrayが元になる配列、
第2引数targetColumnが抽出条件となる列、
第3引数targetValueが抽出条件となる値である。

返り値は配列なんだけれども、As Variant()とするといろいろ面倒なので、単にAs Variantとした。

(2)と(3)の

  If Not isInitialized_ Then Call catchException(thrownException10001)
  If getArrayDimension(targetArray) <> 2 Then Call catchException(thrownException10002)

はコード内のコメントにもあるようにガード節。VirtualTableクラスのインスタンスinitメソッドが未実行だったり、第1引数targetArrayが2次元配列でなかった場合にはエラーを吐くようにしている。コード内のcatchExceptionとかgetArrayDimensionというのは、クラス内で定義しているローカルメソッド。前者はエラーを吐くためのもの、後者は配列の次元数を返すもので、後者については、後のリスト1-2で紹介する。

で、(4)からがメソッドの本体。

(4)からの2行

Dim returnArray As Variant
ReDim returnArray(1 To 1, 1 To UBound(targetArray, 2))

で、抽出後の配列を格納する変数を準備する。

宣言後、即とりあえず1次元目の要素数を「1」、2次元目の要素数を元の配列と同じ数にしてReDimしておく。

(5)からの2行

Dim n As Long
n = 1

では、Long型の変数 n を準備し、「1」で初期化。

これは、抽出後の配列の1次元目のインデックスとして用いる。

(6)からの10行(コメント除く。実質9行)

For i = LBound(targetArray, 1) To UBound(targetArray, 1)
  If targetArray(i, targetColumn) = targetValue Then
    If n > 1 Then returnArray = _
                    expand2DimentionalArray(returnArray, 1)    '……(7)'
    For j = LBound(targetArray, 2) To UBound(targetArray, 2)    '……(8)'
      '各列の要素を追加'
      returnArray(n, j) = targetArray(i, j)
    Next
    n = n + 1    '……(9)'
  End If
Next

では、元の配列をループして条件に合致するかどうかを判定、条件に合致した行のデータをreturnArrayに格納している。

元の配列のtargetColumn列目のデータがtargetValueと一致していたら条件に合致したということ。

その場合は、(7)の

If n > 1 Then returnArray = _
                    expand2DimentionalArray(returnArray, 1)

nが2以上になっていると、その都度expand2DimentionalArrayメソッドを用いて配列の1次元目の上限を1だけ拡張する。

expand2DimentionalArrayメソッドもクラス内のローカルメソッド。こちらは後のリスト1-3で紹介する。

配列の拡張ができたら、(8)からの3行(コメント除く)

For j = LBound(targetArray, 2) To UBound(targetArray, 2)
  returnArray(n, j) = targetArray(i, j)
Next

で元の表のi行目の各列の値を、returnArrayのn行目各列に格納する。

あとは、(9)の

 n = n + 1

nをインクリメントする。

あとは、(10)の

filteredArray_ = returnArray
  getFilteredArray = returnArray: Exit Function

で、クラス内のPrivate変数filteredArray_に抽出後の配列returnArrayをコピーした上でreturnArrayを返しておしまい。

お次に、このメソッド内から呼ばれるPriveteメソッドを紹介する。

リスト1-2 クラスモジュール
Private Function getArrayDimension( _
                  ByRef targetArray As Variant) As Long
  If Not IsArray(targetArray) _
    Then getArrayDimension = False: Exit Function
  Dim n As Long
  n = 0
  Dim tmp As Long
  On Error Resume Next
  Do While Err.Number = 0
    n = n + 1
    tmp = UBound(targetArray, n)
  Loop
  Err.Clear
  getArrayDimension = n - 1
End Function

これは、

akashi-keirin.hatenablog.com

このときに紹介したもの。それをそのまま使っている。

エラーが出ることを利用している、というのは余り健全ではないのかもしれないが、他に方法が思いつかない。

リスト1-3 クラスモジュール
Private Function expand2DimentionalArray( _
                   ByRef targetArray As Variant, _
                   ByVal addRows As Long) As Variant()
  Dim returnArray As Variant
  ReDim returnArray(LBound(targetArray, 1) To _
                    UBound(targetArray, 1) + addRows, _
                    LBound(targetArray, 2) To _
                    UBound(targetArray, 2))
  Dim maxRowIndex As Long
  If addRows >= 0 Then
    maxRowIndex = UBound(targetArray, 1)
  Else
    maxRowIndex = UBound(returnArray, 1)
  End If
  Dim maxColumnIndex As Long
  maxColumnIndex = UBound(targetArray, 2)
  Dim i As Long
  Dim j As Long
  For i = LBound(targetArray, 1) To maxRowIndex
    For j = LBound(targetArray, 2) To maxColumnIndex
      returnArray(i, j) = targetArray(i, j)
    Next
  Next
  expand2DimentionalArray = returnArray
End Function

説明がメンドクサイので説明は省略する。

第1引数targetArrayで元の配列、第2引数addRowsで1次元目の拡張数を受け取って、元の配列の1時限目の要素数addRows個だけ拡張した配列を返す、というもの。

いちおう、addRowsで負の数が渡されても良いようにはしてある(テスト不足なので、こんなに強気に言い切っていいのかどうかは不明)。

使ってみる

f:id:akashi_keirin:20180506191411j:plain

ワークシートにこんな表を用意しておく。

で、次のコードで実験。

スト2 標準モジュール
Public Sub testNewVirtualTable()
  Dim virtualTable_ As New VirtualTable
  With virtualTable_
    Call .init(Sheet1.Range("A1").CurrentRegion)
    Call .getFilteredArray(targetArray:=.tableArray, _
                           targetColumn:=3, _
                           targetValue:="千葉県")    '……(1)'
    Dim tmpArray As Variant
    tmpArray = .filteredArray    '……(2)'
    Dim i As Long
    For i = LBound(tmpArray, 1) To UBound(tmpArray, 1)    '……(3)'
      Debug.Print tmpArray(i, 1)
    Next
  End With
  Set virtualTable_ = Nothing
End Sub

VirtualTableクラスのインスタンスを生成し、initメソッドで表を2次元配列として格納したら、(1)の

Call .getFilteredArray(targetArray:=.tableArray, _
                       targetColumn:=3, _
                       targetValue:="千葉県")

getFilteredArrayを実行する。

第1引数のtableArrayというのは、VirtualTableクラスのプロパティで、initメソッドで渡した配列を返す、と思ったら良い。

第2引数targetColumnに「3」、第3引数targetValueに「千葉県」を渡しているので、元の表のC列が「千葉県」になっているレコードだけを抽出して格納した2次元配列が作成されることになる。

(2)の

tmpArray = .filteredArray

は、変数tmpArrayvirtualTable_.filteredArrayを代入する形になっている。

filteredArrayというのも、VirtualTableクラスのプロパティで、getFilteredArrayメソッドの実行によって作成された配列が返るようになっている。

そもそもgetFilteredArrayメソッドがFunctionなので、ここは

tmpArray = .getFilteredArray(targetArray:=.tableArray, _
                             targetColumn:=3, _
                             targetValue:="千葉県")

と書いても良かったところ。

あとは、(3)の

For i = LBound(tmpArray, 1) To UBound(tmpArray, 1)
  Debug.Print tmpArray(i, 1)
Next

で、抽出されてできた配列の1列目をイミディエイトに出力させるようにした。

実行結果

f:id:akashi_keirin:20180506191421j:plain

こんなふうに表示された。

f:id:akashi_keirin:20180506191428j:plain

元の表をフィルターで抽出してみると、

f:id:akashi_keirin:20180506191438j:plain

この通り。意図どおりの結果となっていた。

おわりに

すでに、複数条件に対応したメソッドも作成済みです。