君は[Ctrl]＋[J]というショートカットキーを知っていたか(VBE)
[Ctrl]＋[J]というショートカットキー
[Ctrl]＋[J]の働き
Twitterで、thom (id:t-hom) さんが教えてくださった。曰く、
識別子はCtrl+Jで入力候補でる
と。
え？ そ、そうなんすか？？？
というわけでちょっとやってみた。
変数名の入力中に[Ctrl]＋[J]
こんなふうに、変数targetRangeが宣言済みの状態で、tarまで入力して、[Ctrl]＋[J]をポチッと押してみる。
うおお！ ほんまや！
おわりに
「(ﾟДﾟ)ﾊｧ? そんなことも知らなかったの？？？」とか、笑わば笑え。
変数名を役割明示的にするために、変数名がむやみに長くなりがちなので、このワザを覚えたのは大きい。
カーソルを任意の位置に置く(Word)
カーソルを任意の位置に置く
たぶんWord2010のバグだと思うのだけれど、均等割付を施したところに差込フィールドがあると、差し込まれた後に字幅がおかしくなる。
職場のPCでしか遭遇しない症状なので、画像でお見せできないんだけれど、データが差し込まれた瞬間、字幅が異様に縮まってそのままになってしまう。
特に困るのは、
これを使ってレコードごとにドキュメントを作成したとき。
差し込むデータの文字数によって、字幅が広がったり狭まったりして、ガタガタになってしまう。
できあがったものを開いて、均等割付部分にカーソルを当てると元に戻るのだが、いちいち開いてはクリック、とかやっていたのでは、何のために自動化したのか分からない。
そこで、作成する文書に応じてRangeプロパティを使って
targetDocument.Range(1,1).Select
みたいなのを書いていた。
ところが、均等割付を施す場所なんて文書によってまちまちだから、テンプレートになる文書の均等割付の場所に応じてその都度指定するRangeプロパティの引数を調整する、という実にアホなことになっている。
Selection.GoToメソッド
「○ページ目の○行目の○文字目にカーソルを置く」ようなメソッドを作れば、少しは指定しやすくなると思って調べてみると、Selection.GoToメソッドというものを見つけた。
例によってMSDNのSelection.GoToメソッドのページによると、
指定した項目の直前の文字位置にカーソルを移動します。
という実に素っ気ない記述。引数が４種類あるけれど、それらは、
パラメータ
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を作ってみた。
リスト１ 標準モジュール
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
で引数と返り値の設定。
第１引数targetPageでページ数、
第２引数targetLineで何行目か、
第３引数targetCharacterで何文字目かを渡す。
返り値はBoolean型。成功したらTrue、失敗したらFalseを返す。
(2)の
Call Selection.GoTo(What:=wdGoToPage, _
Which:=wdGoToAbsolute, _
Count:=targetPage)
では、Selection.GoToメソッドを用いてまずはページ移動。
引数WhatにwdGoToPageを指定しているのでページ単位の移動、引数WhichにwdGoToAbsoluteを指定しているので、文書全体の引数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と見なされるっぽいのだ。
従って、引数targetLineが1（つまり○ページ目の１行目というとき）は、何もしない、ということになる。何もしない、ということを明示するためにあえてこのような書き方にした次第。
(2)実行直後にカーソルは引数targetPage目の先頭にあるので、引数WhichはwdGoToRelativeにした。
このとき、Countが1だと２行目先頭にカーソルが移動するようなので、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)
「標準」スタイルのフォントを変更するメソッド
前回
のつづき。
一発で「標準」スタイルのフォント設定を変更することができるようなマクロを作ってみる。
リスト１ 標準モジュール
'///標準スタイルのフォントを設定する'
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)からの５行（実質４行）
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)からの５行
If isFarEast Then '……(7)' fontBeforeChange = .Styles(styleIndex).Font.NameFarEast Else fontBeforeChange = .Styles(styleIndex).Font.Name End If
で、引数isFarEastの値に応じて処理を分ける。
isFarEastがTrueだったら、現時点の日本語用フォントの名前を変数fontBeforeChangeにぶち込んでおく。
逆に、isFarEastがFalseだったら、現時点の英数字用フォントの名前を変数fontBeforeChangeにぶち込んでおく。
この後の処理でエラーが出るなどして実行できなかったときに、フォント設定を元に戻すため。
やっとメインの処理。(8)からの４行
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)からの７行
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]。
ちなみに、
このときにも紹介したように、Privateメソッドであっても、[モジュール名].[メソッド名]とすれば、イミディエイト・ウィンドウで実行することができる。
ちゃんと「194」が返っている。
setFontForStandardStyleプロシージャ
次のコードで実行してみる。
リスト２ 標準モジュール
Public Sub testSetFontForStandardStyle()
Call setFontForStandardStyle("ＭＳ ゴシック", True)
End Sub
setFontForStandardStyleの引数fontNameに「"ＭＳ ゴシック"」を、引数isFarEastに「True」を渡しているだけ。意図どおりならば、日本語用フォントが「ＭＳ ゴシック」になるはず。
実行結果
この状態で実行すると、
こうなる。意図どおり。
このマクロをクイック アクセス ツール バーにでも仕込んでおいたら、１クリックで「標準」スタイルのフォント設定を変えることができるし、Dir関数、Documents.Openメソッドと組み合わせたらフルオートでフォルダ内一括変換とかもできそう。あんまり需要はないだろうけれど。
追記
コードを修正しました。
リスト２ 標準モジュール
'///標準スタイルのフォントを設定する'
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)
「標準」スタイルのフォントを変える
前回
のつづき。
ウチの環境では、Document.Styles(194)で「標準」スタイルにアクセスできるのだった。
Style.Fontオブジェクト
MSDN Dev Centerの「Style Members (Word)」によると、フォントの設定はFontプロパティにアクセスしてFontオブジェクトを取得して操作するっぽい。
で、Fontオブジェクトのページ（MSDN Dev Centerの「Font Members (Word)」）を見てみると、フォント名を設定／取得するっぽいものとして
NameNameAsciiNameBiNameFarEastNameOther
この５種があった。
詳しくはリンク先の記載内容をお読みいただくとして、基本的にはNameプロパティ（英数字用）、NameFarEastプロパティ（日本語用）を設定すればいいっぽい。
イミディエイト・ウィンドウで確認する
イミディエイト・ウィンドウに、
?thisdocument.Styles(194).Font.NameFarEast
および、
?thisdocument.Styles(194).Font.Name
と入力して確認してみる。
この通り、NameFarEastの方は「ＭＳ 明朝」、Nameの方は「Century」が返った。
Word本体の方に戻って、スタイル ギャラリーで確認してみると、
ぴったり一致している。
つまり、Document.Style.Font.NameFarEastで日本語用フォント、Document.Style.Font.Nameで英数字用フォントを設定することができるということだ。
「標準」スタイルのフォント設定をVBAで変えてみる
イミディエイト・ウィンドウに
thisdocument.Styles(194).Font.NameFarEast = "ＭＳ ゴシック"
と入力して[Enter]してみる。
意図どおりの結果になっている。
これで面倒だった作業が１クリックでできるめどが立った。
Wordの「スタイル」をVBAで操作する(Word)
Wordの「スタイル」をVBAで操作する
ウチの職場には、書類の英数字は等幅という謎ルールがある。
まあ、位置が揃わないのが嫌なのはなんとなく分かる。
ただ、「スタイル」という機能を知らずにWordを使っている人がほとんど（目測で９割以上）なので、
文書作成→文書全体を選択→フォントを「ＭＳ 明朝」に変更
という
最高にロックなイカしたやり方
をする人がほとんど。
っていうか、ドヤ顔で
最後に全体を選択して「ＭＳ 明朝」に変えたら楽やないか！
と推奨する人までいる（実話）。
そんなわけで、ウチで量産されるWord文書は、「標準」スタイルの英数字フォントの設定がデフォルトの「Century」のままなのに、英数字の箇所はことごとく「ＭＳ 明朝（またはゴシック）」という最高にクールなことになっているのである。
スタイルを変更するのはめんどくさい
書類なんかは、前年度のものを使い回すことが多いので、当然「標準スタイル」の英数字フォントがCenturyのままなのに、英数字のところが「ＭＳ 明朝」に無理矢理変えられているだけの文書を扱う機会が多い。っていうか、ほぼそんな感じ。
したがって、「標準」スタイルのフォント設定を変更するという作業が発生するのだが、正攻法でやると結構めんどくさい。
「標準」スタイルの英数字フォント設定を変更する手順
- 「ホーム」タブの「スタイル ギャラリー」で「標準」を右クリック
- 「変更」をクリック
- 「書式」ボタンをクリック
- 「フォント」をクリック
- 「フォント」タブの「英数字用のフォント」のドロップダウンリストから「（日本語用と同じフォント）」を選択
- [ＯＫ]をクリック
- [ＯＫ]をクリック
と、実に７段階もの作業が生ずるのである！
こういう単純作業はマクロ化するに限る。
Document.Styleオブジェクト
ちょいと調べてみると、「スタイル」そのものは、Documentオブジェクトの配下にあるStylesコレクションの一員で、Styles（Index）で取得できるということはすぐに分かった。
【参考】MSDN デベロッパー センター「Styles オブジェクト (Word)」
Styleオブジェクトのメンバについては、MSDN デベロッパー センター「Style Members (Word)」に掲載されているが、英語版しかないみたい。
「標準」スタイルのインデックス番号を割り出す
オブジェクト ブラウザーで、Styleオブジェクトのメンバを列挙してみる。
どうもNameLocalというやつがスタイルの日本語名を指すっぽい（なんでコイツだけ変なアイコンなんだろ？）。
MSDN デベロッパー センター「Style Members (Word)」での説明も、
Returns the name of a built-in style in the language of the user. Read/write
String.
となっている。「ユーザーの言語での組み込みスタイル名を返す」ぐらいか。
で、次のコードで「標準スタイル」のインデックス番号を割り出すことを試みた。
リスト１ 標準モジュール
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 EachでStylesコレクションを巡回して、1から順に番号を付けてスタイル名をイミディエイトに表示するだけのコード。
別にFor Eachじゃなくても、普通のFor文でも書ける（For i = 1 To ThisDocument.Styles.Countにする）。
[F8]連打でステップ実行を繰り返すと、
発見！
ウチの環境では、「194」というのが「標準」スタイルのインデックス番号らしい。
Document.Styles(194)で「標準」スタイルオブジェクトにアクセスできるので、あとはオブジェクトの操作の仕方さえ分かったらマクロ化が可能になる。
VirtualTableクラスへのメソッドの追加[getFilteredArrayメソッド]
VirtualTableクラス続報
指定した条件を満たす配列を返すメソッド
任意の列の値が指定した値であるレコードだけを格納した配列を返すメソッドを作ってみた。
ひとまずコードを載っけておく。
getFilteredArrayメソッドのコード
リスト1-1 クラスモジュール
'///２次元配列（引数１）から任意の列（引数２）の値が、任意の値（引数３）である'
' 要素だけを抽出した２次元配列を返す'
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)'
'///ガード節。引数１が２次元配列でなかったらエラーを吐く。'
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
'２要素目以降は、配列を拡張してから要素を追加する'
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
で引数と返り値の設定。
冒頭のコメントにもあるように、
第１引数targetArrayが元になる配列、
第２引数targetColumnが抽出条件となる列、
第３引数targetValueが抽出条件となる値である。
返り値は配列なんだけれども、As Variant()とするといろいろ面倒なので、単にAs Variantとした。
(2)と(3)の
If Not isInitialized_ Then Call catchException(thrownException10001) If getArrayDimension(targetArray) <> 2 Then Call catchException(thrownException10002)
はコード内のコメントにもあるようにガード節。VirtualTableクラスのインスタンスのinitメソッドが未実行だったり、第１引数targetArrayが２次元配列でなかった場合にはエラーを吐くようにしている。コード内のcatchExceptionとかgetArrayDimensionというのは、クラス内で定義しているローカルメソッド。前者はエラーを吐くためのもの、後者は配列の次元数を返すもので、後者については、後のリスト1-2で紹介する。
で、(4)からがメソッドの本体。
(4)からの２行
Dim returnArray As Variant ReDim returnArray(1 To 1, 1 To UBound(targetArray, 2))
で、抽出後の配列を格納する変数を準備する。
宣言後、即とりあえず１次元目の要素数を「1」、２次元目の要素数を元の配列と同じ数にしてReDimしておく。
(5)からの２行
Dim n As Long n = 1
では、Long型の変数 n を準備し、「1」で初期化。
これは、抽出後の配列の１次元目のインデックスとして用いる。
(6)からの10行（コメント除く。実質９行）
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が２以上になっていると、その都度expand2DimentionalArrayメソッドを用いて配列の１次元目の上限を１だけ拡張する。
expand2DimentionalArrayメソッドもクラス内のローカルメソッド。こちらは後のリスト1-3で紹介する。
配列の拡張ができたら、(8)からの３行（コメント除く）
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
これは、
このときに紹介したもの。それをそのまま使っている。
エラーが出ることを利用している、というのは余り健全ではないのかもしれないが、他に方法が思いつかない。
リスト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
説明がメンドクサイので説明は省略する。
第１引数targetArrayで元の配列、第２引数addRowsで１次元目の拡張数を受け取って、元の配列の１時限目の要素数をaddRows個だけ拡張した配列を返す、というもの。
いちおう、addRowsで負の数が渡されても良いようにはしてある（テスト不足なので、こんなに強気に言い切っていいのかどうかは不明）。
使ってみる
ワークシートにこんな表を用意しておく。
で、次のコードで実験。
リスト２ 標準モジュール
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メソッドで表を２次元配列として格納したら、(1)の
Call .getFilteredArray(targetArray:=.tableArray, _
targetColumn:=3, _
targetValue:="千葉県")
でgetFilteredArrayを実行する。
第１引数のtableArrayというのは、VirtualTableクラスのプロパティで、initメソッドで渡した配列を返す、と思ったら良い。
第２引数targetColumnに「3」、第３引数targetValueに「千葉県」を渡しているので、元の表のＣ列が「千葉県」になっているレコードだけを抽出して格納した２次元配列が作成されることになる。
(2)の
tmpArray = .filteredArray
は、変数tmpArrayにvirtualTable_.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
で、抽出されてできた配列の１列目をイミディエイトに出力させるようにした。
実行結果
こんなふうに表示された。
元の表をフィルターで抽出してみると、
この通り。意図どおりの結果となっていた。
おわりに
すでに、複数条件に対応したメソッドも作成済みです。
Worksheet_Changeイベントの引数Target(Excel)
Worksheet_Changeイベントの引数Target
Worksheet_Changeイベントについては、イベントを起こすセル範囲を限定するのによく使う。
引数「Target」に関する注意事項
Worksheet_Changeイベントが発生したときに、プロシージャに渡される引数Targetについて、ちょっと気をつけておいた方が良いことに気づいたので、備忘録的に記しておく。
まず、Worksheet_Changeのイベントプロシージャとして、次のコードを書いておく。
Private Sub Worksheet_Change(ByVal Target As Range) Debug.Print "引数TargetのCountプロパティ：" & Target.Count End Sub
引数TargetのCountプロパティをイミディエイト・ウインドウに表示するだけのプロシージャ。
フィルハンドルでドラッグしたとき
こんなふうに、ドラッグしてコピーしたときの引数Targetは、
これでお分かりのように、ドラッグした範囲全てである。
行ごと削除した場合
こんなふうに、行を丸ごと選択して、削除する。
147456!!!!!!!!
すさまじい数のRangeオブジェクトが渡されている。
行ごと／列ごと削除の場合に何もせずにExitする
Targetの中身を調べて、その中身次第でイベントプロシージャの処理を実行するかどうかを分岐したいとき、列ごと削除や行ごと削除された日には、すさまじい回数の計算が生ずることになる。かといって、通常の操作におけるセルの上限個数なんて決められない場合がある。
たとえば、フィルハンドルで値をコピーしたときにはそれぞれのセルの値に応じて処理をしたい、というようなとき、ドラッグする範囲の上限なんて決められない。そんなときに、【列ごと削除した】とか【行ごと削除した】ようなときにはイベント処理をしない、というふうにできれば良い。
次のようなコードを考えた。
リスト１
With Target
If .Count Mod Rows.Count = 0 Or _
.Count Mod Columns.Count = 0 Then Exit Sub
End With
こいつをWorksheet_Changeプロシージャの先頭に入れる。
要するに、TargetのCountプロパティがRows.CountとかColumns.Countで割り切れる場合は、行ごと／列ごと変化したとみなして処理を飛ばすわけだ。
行ごと削除してみると、TargetのCountプロパティが98304になっていることが分かる。
Columns.Countの値（１行あたりのセルの総数）は16384。
ご覧のように、98304は16384で割り切れるので、何もせずにExitすることになる。
おわりに
Targetに複数のセルが渡されたときは、Target.Valueとか書いているとエラーになるので、注意が必要。
追記
よく考えたら、
TargetのCountプロパティがRows.CountとかColumns.Countで割り切れる場合は、行ごと／列ごと変化したとみなして処理を飛ばす
というのは余りにも乱暴なやり方だった。
値を書き換えたセル範囲のセルの数（Countプロパティ）がたまたまRows.CountとかColumns.Countの倍数だったりすると、行・列削除だとみなされてしまうことになる（まあ、そんなことは滅多にないだろうけれど）。
それはいくらなんでも、いくらなんでもそれはご勘弁願いたい。というわけで、コードを書き換えてみた。
っていうか、ついでにセル範囲が行または列全体かどうかを判定するFunctionを作ってみた。
リスト１改
Public Function isWholeRowORColumn(ByVal targetRange As Range) As Boolean
With targetRange
If .Rows.Count = Rows.Count Or _
.Columns.Count = Columns.Count Then _
isWholeRowORColumn = True: Exit Function
End With
isWholeRowORColumn = False
End Function
引数で渡されたセル範囲targetRangeの縦幅（targetRange.Rows.Count）がシート全体の縦幅（Rows.Count）と等しかったら列全体、targetRangeの横幅（targetRange.Columns.Count）がシート全体の横幅（Columns.Count）と等しかったら行全体が変化したとみなす。
問題は、列全体または行全体に値が書き込まれた場合だな……。
