表の中でのセルの位置を特定する(Word)

表の中でのセルの位置を特定する(Word)

Excelの表に比べて、Wordの表は勝手に改竄されることが今まで少なかったので、完全に油断していた。

Wordで集めた大量のドキュメント。ファイル名の付け方がバラバラなので、整理が大変。そこで、ドキュメント内に記入されている情報を元に、ファイル名をリネームすることにしたのです。たとえば、[会員番号] - [名前].docxみたいに。

あくまでも急場しのぎのマクロだし、そもそもWordの表に勝手に行や列を挿入するやつもまれだったので、「会員番号」とか「名前」を取得する表のインデックスとか、行番号、列番号なんて決め打ちで十分と思っていた。

しかし、現れやがったんですよ。強者が。

勝手に名前記入欄をすぐ下の表に接着するやつ

とか、

勝手に新しい表を挿入するやつ

なんかが・゜・(ノД`)・゜・。

しかも、一人や二人やない。ちょいちょい処理が止まる……。

とりあえず、その場は応急処置で乗り切ったが、この際なので一般化できるようにWordのTableオブジェクトについて勉強しておくことにした。

とりあえずキーワードを含むセルを返すFunctionを作る

今回の場合だと、まずは、たとえば、「会員番号」という文字列のあるセルを特定したい。

考え方

で、次のように考えた。

  • ドキュメント内のTableオブジェクトを全て巡回
  • Tableオブジェクト内のCellオブジェクトを総当たり
  • CellオブジェクトのRange.Textプロパティがキーワードを含んでいたら、そのCellオブジェクトを返す

ひとまずこんな感じ。

コード

ドキュメント内の全ての表のセルを巡回して、キーワードがヒットしたらそのセルを返すFunction。

リスト1
Public Function getCell( _
            ByVal KeyWord As String, _
   Optional ByVal tgtDoc As Document) As Cell
  Dim ret As Cell
  Set ret = Nothing
  '引数tgtDocが省略されていたらActiveDocumentをセット'
  If tgtDoc Is Nothing Then
    Set tgtDoc = ActiveDocument
  End If
  '全Tableを巡回'
  Dim tbl As Table
  For Each tbl In tgtDoc.Tables
    Set ret = getFoundCell(tbl, KeyWord)
    If Not ret Is Nothing Then Exit For
  Next
  Set getCell = ret
End Function
'Table内の全セルを巡回。キーワード見つけ次第return'
Private Function getFoundCell( _
             ByVal tgtTable As Table, _
             ByVal KeyWord As String) As Cell
  Dim ret As Cell
  Dim r As Long
  Dim c As Long
  Dim tmp As String
  For r = 1 To tgtTable.Rows.Count
    For c = 1 To tgtTable.Columns.Count
      'Cellオブジェクトを取得'
      Set ret = tgtTable.Cell(r, c)
      'セル内の文字列を取得'
      tmp = ret.Range.Text
      '右端のBELと改行コードを除去'
      tmp = Left(tmp, Len(tmp) - 2)
      'キーワードを含んでいたらreturn'
      If InStr(1, tmp, KeyWord) > 0 Then
        GoTo Finalizer
      End If
    Next
  Next
  Set ret = Nothing
Finalizer:
  Set getFoundCell = ret
End Function

とりあえずこんな感じ。本当なら、キーワードとセル内文字列の比較について、完全一致とか前方一致とかが選べるようにしたいけれど、ひとまず後回し。

使ってみる

f:id:akashi_keirin:20200602081307j:plain

このようなドキュメント(笑)を用意して、次のコードで使ってみる。

スト2
Private Sub test01()
  Dim tgtCell As Cell
  Set tgtCell = getCell("会員番号")
  Debug.Print tgtCell.RowIndex
  Debug.Print tgtCell.ColumnIndex
End Sub

こいつを実行すると、イミディエイト・ウィンドウに、

f:id:akashi_keirin:20200602081310j:plain

このように表示された。

うむ。バッチリである。

ついでにオフセットしたセルを取得するFunctionを作る

CellオブジェクトのParentプロパティを参照すれば、

f:id:akashi_keirin:20200602081313j:plain

この画像でおわかりのように、親のTableオブジェクトを取得することができる。

Cellオブジェクトからは、表の中での行番号、列番号を返すRowIndexColumnIndexプロパティがある。

……ということは、ExcelOffsetプロパティみたいなことができるはずだ。

よーし。作っちゃえ!

考え方

次のような仕様にすれば良い。

  • Cellオブジェクトと、行・列それぞれのオフセットサイズを受け取る
  • CellオブジェクトのParentプロパティを参照してTableオブジェクトを取得する
  • 行・列のオフセットサイズを元に、取得したいCellオブジェクトの表内での位置を求める
  • [Table].Cellメソッドで、取得したいCellオブジェクトを取得する

こんな感じ。

コード

上記のような考え方でコーディングした。

リスト3
Public Function getOffsetCell( _
            ByVal tgtCell As Cell, _
            ByVal RowOffset As Long, _
            ByVal ColumnOffset As Long) As Cell
  Dim ret As Cell
  Set ret = Nothing
  Dim currTable As Table
  Set currTable = tgtCell.Parent
  Dim r As Long
  r = tgtCell.RowIndex + RowOffset
  'rの値がおかしくなったらNothingを返す'
  If r < 1 Then GoTo Finalizer
  If r > currTable.Rows.Count Then GoTo Finalizer
  Dim c As Long
  c = tgtCell.ColumnIndex + ColumnOffset
  'cの値がおかしくなったらNothingを返す'
  If c < 1 Then GoTo Finalizer
  If c > currTable.Columns.Count Then GoTo Finalizer
  'オフセットしたセルを返す'
  Set ret = currTable.Cell(r, c)
Finalizer:
  Set getOffsetCell = ret
End Function

うむ。これで良い。

使ってみる

このドキュメント(笑)から、会員番号を取得して見せよう。

リスト4
Private Sub test02()
  Dim tgtCell As Cell
  Set tgtCell = getOffsetCell(getCell("会員番号"), 0, 1)
  Debug.Print tgtCell.Range.Text
End Sub

行オフセットサイズを0、列オフセットサイズを1にしているので、一つ右のセル、すなわち会員番号を取得できるはずだ。

こいつを実行すると、イミディエイト・ウィンドウは、

f:id:akashi_keirin:20200602081316j:plain

うむ。

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

?getOffsetCell(getCell("名前"), 0, 1).Range.Text

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

f:id:akashi_keirin:20200602081602j:plain

うむ。完璧である!!!!!!!!

おわりに

アクロバチック入力に対抗するのはなかなか大変である……orz

参照元に参照先の通し行番号を書き込む(1)

参照元に参照先の通し行番号を書き込む(1)

Wordの本文中で、参照箇所を明示したいときがある。段落番号とか見出しだったら、「相互参照」機能を使って文中に挿入できて、変更にも追随してくれるから良いのだが、通し行番号だけは、どうにもやり方がわからなかった。(もし「標準機能にあるで!」というのがあれば教えろ教えてください。)

行番号の参照などというものは、常に揺れ動くものなので、手動で管理するのは死ぬほどめんどくさいし、絶対に修正漏れが起こる。そこで、「ブックマーク」機能を使って解消することを考えた。

基本的には前回

akashi-keirin.hatenablog.com

までの続きです。

Bookmarkオブジェクトを使う

考え方

「ブックマーク」という機能を使えば、文書中の任意の場所に名前を付けることができる。VBAでは、Bookmarkオブジェクトを操作することによって、「ブックマーク」機能を使うことができる。

そこで、次のように考えた。

  • 参照先の箇所にブックマークを設定する
  • 参照元の「○行目」の行番号の部分(「○」の部分。)にブックマークを設定する
  • 前回作成したFunctionを用いて、参照先の通し行番号を取得する
  • 取得した行番号を文字列型に変換して「○」の部分に上書きする

こんな感じ。

ブックマークの設定

とりあえず、今回は手動で設定する。

まずは参照先。

f:id:akashi_keirin:20200601080004j:plain

このように、64行目の先頭に「参照先01」というブックマークを設定。

次に参照元

f:id:akashi_keirin:20200601080008j:plain

このように、「○行目」の「○」の部分に「参照元01」というブックマークを設定。

以上。

ブックマークした箇所(Rangeオブジェクト)の取得

まず、上記で設定したブックマークについて、Bookmarkオブジェクトを取得する方法。

これは、まずDocumentオブジェクトのBookmarksプロパティを参照してBookmarksコレクションを取得する。

んで、あとはItemメソッドのインデックスに取得したいブックマークの名前を指定すれば良い。

Itemは省略できるので、実際の書き方は

Document.Bookmarks("[ブックマーク名]")

になる。

Bookmarkオブジェクトが取得できれば、あとはそのRangeプロパティを参照すれば、ブックマークした箇所のRangeオブジェクトが取得できる。実に簡単。

参照元の文字を行番号に置き換える

参照元の「○」の部分をRangeオブジェクトとして取得しているのだから、あとはそのTextプロパティを書き換えたら良い。

楽勝!

コード

参照元に参照先の通し番号を挿入するコードは次の通り。

処理の中で、前回作成したgetLineNumberメソッドを呼び出しているので、そのコード(標準モジュールLineNumUtilに記載。)も再掲する。

リスト1 標準モジュール ModuleMain
Private Sub test00()
  Dim Doc As Document
  Set Doc = Application.ActiveDocument
  '参照元のブックマークオブジェクトを取得'
  Dim bm As Bookmark
  Set bm = Doc.Bookmarks("参照元01")
  '参照先ブックマークの通し行位置を取得'
  Dim lineNum As Long
  lineNum = LineNumUtil.getLineNumber(Doc.Bookmarks("参照先01").Range)
  '参照元のテキストを書き換える'
  bm.Range.Text = CStr(lineNum)
End Sub
スト2 標準モジュール LineNumUtil
Public Function getLineNumber( _
            ByVal tgtRange As Range) As Long
  Dim ret As Long
  'tgtRangeのあるページ番号を取得'
  Dim currPage As Long
  currPage = tgtRange.Information(wdActiveEndPageNumber)
  'tgtRangeのあるページ内での行番号を取得'
  Dim currLine As Long
  currLine = tgtRange.Information(wdFirstCharacterLineNumber)
  'tgtRangeが1ページ目にあるときは、その行番号を返す'
  If currPage = 1 Then
    ret = currLine
    GoTo Finalizer:
  End If
  '2ページ以上ある時は、手前のページまでの累計を足さなければいけない'
  Dim Doc As Document
  Set Doc = tgtRange.Parent
  'カーソル位置を記録'
  Dim orgRange As Range
  Set orgRange = Selection.Range
  '文書の先頭にカーソルを置く'
  Call Doc.Range(0, 0).Select
  '1ページ目の最終位置を取得'
  Dim pageEnd As Long
  '1ページ目の最終位置を選択'
  Dim i As Long
  For i = 1 To currPage - 1
    pageEnd = Doc.Bookmarks("\Page").End
    Call Doc.Range(pageEnd - 1, pageEnd - 1).Select
    ret = ret + Selection.Range.Information(wdFirstCharacterLineNumber)
    '次のページの先頭へ'
    Call Selection.MoveRight(wdCharacter, 1, wdMove)
  Next
  ret = ret + currLine
  'カーソル位置を戻す'
  Call orgRange.Select
Finalizer:
  getLineNumber = ret
End Function

例によって細かくコメントを入れたので、説明は省略。

うむ。これで盤石のはずだ!

使ってみる

リスト1を実行すると、

f:id:akashi_keirin:20200601080011j:plain

ウホッ! 完璧!

こんどは、

f:id:akashi_keirin:20200601080014j:plain

こんなふうにテキトーに参照先の位置をズレータにしておいて、再度実行!

f:id:akashi_keirin:20200601080017j:plain

な・・・・なんだってーーー!?

キ、キバヤシ……。これは一体どういうことなんだよ……。

あふれる涙を抑えながら「ブックマーク」を調べると、

f:id:akashi_keirin:20200601080020j:plain

なんと、テキストを書き換えたブックマーク(参照元01)が消えとる……orz

おわりに

どうも間違えてロンしてしまったか、フリテンだったようだ。

もう一工夫必要だということだ。

WordVBAはおれを甘やかしてくれぬ……。

で、今回の教訓。

BookmarkオブジェクトのRange.Textを書き換えるとBookmarkオブジェクトは消滅する。

覚えておこう。

通しの行番号を取得するFunction(Word)

通しの行番号を取得するFunction(Word)

前回

akashi-keirin.hatenablog.com

の続き。

文書全体を通じての通しの行位置を取得するFunctionを作った

考え方

[Range].Informationプロパティを参照すれば、Rangeオブジェクトのあるページ位置(Information(wdActiveEndPageNumber))とか、ページ内での行位置(Information(wdFirstCharacterLineNumber))を取得することができる。

こいつらを組み合わせて、次のような手順で通しの行位置を取得することにする。

  • Rangeオブジェクトのあるページ位置と、そのページ内での行位置を取得する
  • ページ位置が1ページ目にある場合は、そのまま行位置を返す
  • ページ位置が2ページ目以降にある場合は、1ページ目から一つ手前のページまでの行数を累計して加算する

こんな感じ。

ちなみに、各ページの行数を取得するのは、前回述べた方法を用いる。

コード

作成したコードは次の通り。

リスト1
Public Function getLineNumber( _
            ByVal tgtRange As Range) As Long
  Dim ret As Long
  'tgtRangeのあるページ番号を取得'
  Dim currPage As Long
  currPage = tgtRange.Information(wdActiveEndPageNumber)
  'tgtRangeのあるページ内での行番号を取得'
  Dim currLine As Long
  currLine = tgtRange.Information(wdFirstCharacterLineNumber)
  'tgtRangeが1ページ目にあるときは、その行番号を返す'
  If currPage = 1 Then
    ret = currLine
    GoTo Finalizer:
  End If
  '2ページ以上ある時は、手前のページまでの累計を足さなければいけない'
  '親ドキュメントオブジェクトを取得'
  Dim Doc As Document
  Set Doc = tgtRange.Parent
  'カーソル位置を記録'
  Dim orgRange As Range
  Set orgRange = Selection.Range
  '文書の先頭にカーソルを置く'
  Call Doc.Range(0, 0).Select
  Dim pageEnd As Long
  '1ページ目の最終位置を選択'
  Dim i As Long
  For i = 1 To currPage - 1
    'ページの最終位置を取得'
    pageEnd = Doc.Bookmarks("\Page").End
    'ページの末尾にカーソルを置く'
    Call Doc.Range(pageEnd - 1, pageEnd - 1).Select
    'ページ末尾の行番号=そのページの総行数を加算'
    ret = ret + Selection.Range.Information(wdFirstCharacterLineNumber)
    '次のページの先頭へ'
    Call Selection.MoveRight(wdCharacter, 1, wdMove)
  Next
  ret = ret + currLine
  'カーソル位置を戻す'
  Call orgRange.Select
Finalizer:
  getLineNumber = ret
End Function

例によって、コード内に詳しくコメントを書いたので、説明は省略。

これで、Rangeオブジェクトを渡せば、そのRangeオブジェクトがある箇所の、文書内での通しの行位置(通し行番号の値)を取得することができる。

使ってみる

たとえば、

f:id:akashi_keirin:20200531212013j:plain

このように、通しの76行目(2ページ目にある。)にカーソルを置いた状態で、イミディエイト・ウィンドウに

?getLineNumber(Selection.Range)

と書いて[Enter]を押すと、

f:id:akashi_keirin:20200531212016j:plain

このように、ちゃんと「76」が返る。

また、Rangeオブジェクトは、Bookmarkオブジェクトからも取得できる([Bookmark].Rangeプロパティ)ので、たとえば、

f:id:akashi_keirin:20200531212019j:plain

f:id:akashi_keirin:20200531212022j:plain

こんなふうに、64行目にある部分に「参照先01」という名前のブックマークを作成しておき、イミディエイト・ウィンドウに

?getLineNumber(ActiveDocument.Bookmarks("参照先01").Range)

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

f:id:akashi_keirin:20200531212025j:plain

うむ。バッチリである!

おわりに

今回作成したFunctionをうまく使えば、文書中の「○行目参照」の「○」の部分を、参照先が移動しても正しく再設定するマクロが作れると思う。

リーチ!

各ページの行数を取得する(Word)

各ページの行数を取得する(Word)

Wordドキュメントの、各ページの行数を調べる方法を編み出した(笑)ので、覚書として記しておく。

カーソルのあるページの総行数を取得する

[Document].Bookmarks.Item("\Page")の返り値

BookmarksコレクションのItemメソッドのIndex"\Page"を指定すると、カーソルのあるページ全体を表すBookmarkオブジェクトが返るっぽい。

たとえば、テキトーなページのどこかにカーソルを置いて、イミディエイト・ウィンドウに

ActiveDocument.Bookmarks("\Page").Select

と打ち込んで[Enter]してやると、カーソルがあるページ全体が選択された状態になる。

[Bookmark].Endプロパティ

BookmarkオブジェクトのEndプロパティは、そのページの最後の文字の、文書先頭から数えた位置を返す。

したがって、たとえば、

Dim Doc As Document
Set Doc = ThisDocument
Dim pageEnd As Long
pageEnd = Doc.Bookmarks("\Page").End
Call Doc.Range(pageEnd - 1, pageEnd - 1).Select  '……(*)'

このようにすると、カーソルを置いてあったページの一番最後の位置にカーソルを移動させることになる。

[Range].Informationプロパティ

カーソル位置のRangeオブジェクトは、

Selection.Range

とすれば取得できる。

で、RangeオブジェクトにはInformationというプロパティがあり、引数の指定次第で実に色々な情報を取得することができる。

たとえば、WdInformation列挙体のメンバであるwdFirstCharacterLineNumber=10)を指定してやると、そのRangeオブジェクトの1文字目の場所の、ページ内での行番号を返してくれる。

つまり、上掲コードの(*)の段階で、ページ末尾が選択されているので、ここで

Selection.Range.Information(wdFirstCharacterLineNumber)

とすれば、そのページ内の総行数を取得できることになる。

次のページに移動する

これは簡単。

すでにカーソルはページの末尾にあるのだから、一つだけ右に移動すればよい。

カーソルを動かすには、SelectionオブジェクトのMoveRightメソッドを使う。

Call Selection.MoveRight(wdCharacter, 1, wdMove)

これだけ。

各ページの行数を取得するマクロ

上記の各項目を総合して、ドキュメントの各ページの行数を取得して、イミディエイト・ウィンドウに出力するマクロを作った。

リスト1
Private Sub test04()
  Dim Doc As Document
  Set Doc = ThisDocument
  '最初のカーソル位置を記録'
  Dim orgRange As Range
  Set orgRange = Selection.Range
  '文書の先頭を選択'
  Call Doc.Range(0, 0).Select
  '1ページ目の末尾の位置を取得'
  Dim pageEnd As Long
  pageEnd = Doc.Bookmarks("\Page").End
  '1ページ目の末尾を選択'
  Call Doc.Range(pageEnd - 1, pageEnd - 1).Select
  Dim n As Long
  n = 1
  Do
    'ページ末尾のページ内での行番号を出力'
    Debug.Print getPageNumber(n) & " page has " & _
                Selection.Range.Information( _
				wdFirstCharacterLineNumber) & _
                " lines."
    '文書の末尾に到達していたらExit'
    If pageEnd + 1 = Doc.Range.End Then Exit Do
    '一つ右へ。(次のページの先頭位置へ。)'
    Call Selection.MoveRight(wdCharacter, 1, wdMove)
    'ページの末尾位置を取得して選択'
    pageEnd = Doc.Bookmarks("\Page").End
    Call Doc.Range(pageEnd - 1, pageEnd - 1).Select
    'nをインクリメント'
    n = n + 1
  Loop
  '元のカーソル位置に戻す'
  Call orgRange.Select
End Sub

Private Function getPageNumber( _
             ByVal tgtPageNumber As Long) As String
  Dim ret As String
  Select Case tgtPageNumber
    Case 0: ret = "None"
    Case 1: ret = "1st"
    Case 2: ret = "2nd"
    Case 3: ret = "3rd"
    Case Else: ret = CStr(tgtPageNumber) & "th"
  End Select
  getPageNumber = ret
End Function

細かくコメントを入れたので、説明は省略。

各ページを巡回して、そのページに何行あるかを語らせるマクロ。

もちろん、これだけでは何の役にも立たない。

実行

f:id:akashi_keirin:20200527215135j:plain


f:id:akashi_keirin:20200527215026j:plain

このようなドキュメントを準備。

1ページ目が42行、2ページ目が通し行番号で75行目まであるので、33行、ということになる。

上掲リスト1を実行すると、

f:id:akashi_keirin:20200527215030j:plain

バッチリ。

おわりに

これで野望にイーシャンテン

次回の記事で野望にリーチがかかる予定。

参考

続きはコチラ。

akashi-keirin.hatenablog.com

動的リストの作成

動的リストの作成

前にいたことがある職場に今いる知人から相談を受けた。

秘伝のマクロが動かなくなって困っているらしい。

人助けのつもりでそのExcelを送ってもらって中を見てみた。

あー、確かにこんなのあったなー。おれは改造して使っていたけど。

簡単に言うと、

開始番号と終了番号を入力して実行すると、帳票にデータを次々に差し込んで印刷する

という、まあ差込印刷をExcelでやるようなやつ。

ただまあ、差し込むデータの数が番号ごとに異なるので、かなりめんどくさい処理を強引に書いている、というそんな秘伝マクロだった。

で、その

開始番号と終了番号を入力

の部分なんですけれど、無駄にInputBox関数なんか使っている。

しかも、開始番号を入力させるInputBoxには、

1~〇〇までの番号を半角で入力してください

とか、

存在しない番号を入力したら処理が止まります

とか書いてある。

もちろん、続けて出てくる終了番号を入力させるInputBoxには、

開始番号で入力した番号~〇〇までの番号を半角で入力してください

とか、

開始番号で入力した番号よりも小さな番号を入力すると処理が止まります

とか書いてある。

もう絵に描いたような

運用でカバー

だったのである。

「せっかくExcelでやってるんだから、セルに入力してもらったらええやん……。」と思った私は、さっそく改造することにした。

動的なリスト

InputBoxを使う代わりに、ユーザーフォームを使うという手もあるが、たかが入力を制限するだけのためにそこまでする必要もあるまい。

要するに、開始番号と終了番号が望ましい形でしか入力できないようにすればいいのだ。

ほれ、

Excelには「データの入力規則」という機能があるじゃないか!

ということですよ。

まずは静的リスト

たとえば、

f:id:akashi_keirin:20200523081436j:plain

こんなふうに表を用意しておいて、A2セルに「データの入力規則」を適用する。

f:id:akashi_keirin:20200523081439j:plain

「データ」タブから「データの入力規則」へと進み、

f:id:akashi_keirin:20200523081442j:plain

「設定」タブの「入力値の種類」のドロップダウンリストで「リスト」を選択。「元の値」のところに選択肢を並べたリスト範囲(今回の場合なら$D$1:$D$20)を指定してやればよい。

これで、静的なリストなら簡単に作ることができる。

f:id:akashi_keirin:20200523081452g:plain

ただし、これだけでは「自」に「至」よりも大きな数字を入れることができるため、困ったことになる。

そこで、動的リストの作成である!

動的なリスト

「自」欄(A2セル)で入力を許可する数値のリストを、「至」欄(B2セル)の値に応じて変化させたり、その逆をしたりしたい。

そこで、次のように考えた。

  • 「データの入力規則」の「元の値」の指定にINDIRECT関数を用いる
  • INDIRECT関数の引数にする参照アドレスの文字列を「自」欄・「至」欄の値に応じて変化させるセルを作る

およそこのような感じ。

こうすれば、「自」欄・「至」欄入力時に表示されるドロップダウンリストが動的なリストになる。

動的リストの作成

次のような補助セルが必要だと考えた。

  1. 「自」リストの入力に応じて、「至」リストの上限を示すセルのアドレスを作成する
  2. 「至」リストの入力に応じて、「自」リストの下限を示すセルのアドレスを作成する
  3. 上記1.、2.を組み合わせて「自」リスト用の参照範囲アドレスを作成する
  4. 上記1.、2.を組み合わせて「至」リスト用の参照範囲アドレスを作成する

以上の四つだ。

今回は

f:id:akashi_keirin:20200523081446j:plain

このようにした。

F2セルの数式のみコメントで表示しているが、この場合だと

A2セルの入力値が「至」欄の入力値の上限値になる

ようにしている。

「至」リストは、「自」欄の入力値から(つねに)最大の値(今回の場合は「20」)までを受け付ければよいので、「至」リストの参照アドレスは、

f:id:akashi_keirin:20200523081449j:plain

このように先ほどのF2セルの返り値に「":$D$20"」をくっつけてやればよい。

参考までにそれぞれの補助セルについて数式を記しておく。

至リストの先頭行(F2セル)
=IF(A2="","$D$1","$D$"&MATCH(A2,$D$1:$D$20,0))
自リストの先頭行(G2セル)
=IF(B2="","$D$20","$D$"&MATCH(B2,$D$1:$D$20,0))
自リストの参照アドレス(H2セル)
="$D$1:"&G2
至リストの参照アドレス(I2セル)
=F2&":$D$20"

あとは、「自リストの参照アドレス」欄(H2セル)の返り値を「自」欄(A2セル)のリストの「元の値」、「至リストの参照アドレス」欄(I2セル)の返り値を「至」欄(B2セル)のリストの「元の値」

で、それぞれINDIRECT関数の引数にすればよい。

使ってみる

f:id:akashi_keirin:20200523083115g:plain

こんな風に動きます。

いい感じではないでしょうか。

おわりに

私は乏しい知識と経験をもとにこのように考えましたが、他にもいろんなやり方があると思います。

ユーザーの入力に縛りをかける、というのはExcel仕事において非常に大切だと思います。

「もっと良いやり方があるぜ!」という方がいらっしゃいましたら、ぜひ教えろ教えてください。

Wordドキュメントに特定のキーワードが含まれているかどうかを判定する(Word)

Wordドキュメントに特定のキーワードが含まれているかどうかを判定する

困ったこと

めちゃくちゃめんどくさい調べ物をして作ったWordドキュメントが、フラッシュメモリから消えていた。

今使っている安物のフラッシュメモリは、変なところで買ったやつで、しばしばフォルダの中身が突然空になるなど、非常におそろしい動作をするので、それかなとも思った。ただ、フォルダの中身が消えているのではなく、フォルダ構成からして変わっているので、どうもBackup用のディスクからフォルダごと上書きしてしまったらしい。

イチから作り直すことも考えたが、あまりにもめんどくさいので、いちかばちか復元を試みることにした。

DiskDiggerによる復元

ずーっと前に、USBフラッシュメモリが突然「フォーマットしますか?」になったときに世話になったDiskDiggerというフリーソフトでWordドキュメントを復元してみた。

そうすると、

f:id:akashi_keirin:20200520083114j:plain

この状態……。何十個も検出されたのですよ。

この中から、お目当てのファイルを突き止めるのは、大変である。

幸い、紛失したWordドキュメントの中には、かなり特殊な文言が用いられているので、

ドキュメントに特定のキーワードが含まれているかどうかを判定するFunction

を作ったらよいと考えた。

ドキュメントに特定のキーワードが含まれているかどうかを判定するFunction

手順は至極簡単。

  • ドキュメントを開く
  • ドキュメントの全文を取得する
  • 取得した中にキーワードが含まれているかどうか判定する

たったこれだけ。実に簡単。

ドキュメントを開く

これは、[Documents].Openメソッドを使ったらよい。

ドキュメントの全文を取得する

これは、[Document].Range()とすれば、ドキュメントの本体部分のRangeオブジェクトが返るっぽい。

だから、[Document].Range().Textとしてやれば、全文を取得することができる。

コーディング

上記を踏まえて、Functionを作成する。

リスト1
Public Function HasKeyWord( _
            ByVal TgtDocument As Document, _
            ByVal KeyWord As String) As Boolean
  HasKeyWord = True
  If InStr(1, TgtDocument.Range().Text, KeyWord) > 0 Then Exit Function
  HasKeyWord = False
End Function

たったこれだけ。

使ってみる

まずは、このようなWordドキュメント(笑)を準備する。

f:id:akashi_keirin:20200520083119j:plain

このドキュメント(笑)に対して、HasKeyWordメソッドを実行してみる。

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

?HasKeyWord(ThisDocument,"できる・できないのひみつ")

と入力して[Enter]!

f:id:akashi_keirin:20200520083123j:plain

うむ。望み通りの結果を返しておる!

次に、ドキュメント(笑)から「できる・できないのひみつ」を削除し、

f:id:akashi_keirin:20200520083125j:plain

この状態にしてから、イミディエイト・ウィンドウに上掲コードを入力して[Enter]!

f:id:akashi_keirin:20200520083128j:plain

うむ! 素晴らしい!

最後に、1万字超のドキュメントでもやってみる。

f:id:akashi_keirin:20200520083131j:plain

こんなふうに、1万字超のドキュメント内に、こっそり「そんなの、できっこないす!」というキーワード(笑)をしのばせておく。

んで、このドキュメントをアクティブにしておいて、イミディエイト・ウィンドウに

?HasKeyWord(ActiveDocument,"そんなの、できっこないす!")

と入力して[Enter]!

f:id:akashi_keirin:20200520083134j:plain

おおおおおお! バッチリやないかーーーー!

おわりに

……というわけで、このメソッドを用いて、奇跡的に紛失したファイルを無事に見つけ出したのでありました。

めでたしめでたし。

名簿作成マクロのスタイル(1)

名簿作成マクロのスタイル(1)

Excelで名簿を扱うことが多い私。

これまで数多くの名簿を作成してきたなかで、最近だいぶスタイルが固まってきたので、一旦まとめておくことにした。

この先また考え方が変わるかも知れないが。

シートの役割に関するものはシートモジュールに書く

シートの役割を明確化する

そもそものExcelの使い方に関わる部分。多くの達人の皆さんが共通して〈シートごとに役割をハッキリさせよ〉的なことを述べておられると思う。

シートの役割をハッキリさせると、そのシートが請け負うべき機能もハッキリする。

その機能を実現するコードはそのシートのシートモジュールに書けば良いのだ。

たとえば、名簿作成の元になるデータを入れておくシートが必要だろう。

これは、〈1行1レコード・1列に1データ〉の原則に基づいて作るものだろう。

f:id:akashi_keirin:20200503073900j:plain

こんなふうに。

オブジェクト名をつける

私は、このような元データのシートには、

f:id:akashi_keirin:20200503073904j:plain

このように、オブジェクト名を「Sh01Data」として、シート名を「Data」とすることが多い。

オブジェクト名は、デフォルトだと「Sheet1」となっているが、このまま使っていると、大規模なプロジェクトでシート数が9を超えたときに、「プロジェクト エクスプローラー」上での並び順がイマイチになる。

f:id:akashi_keirin:20200503073907j:plain

このように実にうっとうしい並び順になってしまう。

さすがにシート数が99を超すことはないと思うので、シートモジュールのオブジェクト名は〈Shプラスゼロ埋め2桁〉を接頭辞にして命名するようにしている。

シートモジュールに書くコード

さて、では、このシートのシートモジュールには何を書くか。

このシートの役割は、

VBAにデータを提供する

ことである。それ以上でもそれ以下でもない。

その役割を考えたとき、大切なのは、、

データの位置が指し示しやすいこと

及び、、

データが取り出しやすいこと

であろう。

そのために、元データ用のシートモジュールには、だいたい次のコードを書くことが多い。

  • 列番号を表す列挙体
  • 表全体(項目ラベル含む)のRangeオブジェクトを返すプロパティ
  • 表の正味のデータ部分(項目ラベルを含まない表全体)のRangeオブジェクトを返すプロパティ

こいつら。

実際のコード

先に挙げた

f:id:akashi_keirin:20200503073911j:plain

を例に、実際にシートモジュールに書くコードをお目にかけよう。

列番号を表す列挙体

表では、

  • 1列目:名前
  • 2列目:名前ふりがな
  • 3列目:所属
  • 4列目:卒業期
  • 5列目:級
  • 6列目:班
  • 7列目:戦法
  • 8列目:失格

となっている。

そこで、シートモジュールの宣言セクションに次のように列挙体を定義する。

Public Enum Sh01ColumnName
  sh01Name = 1
  sh01Phonetic
  sh01Prefecture
  sh01Generation
  sh01Grade
  sh01Class
  sh01Style
  sh01Unable
End Enum

ポイントは、列挙体の各要素に「sh01」という接頭辞をつけている点。

名簿作成作業の場合、元データから必要なデータだけを抽出して、表示用の別シートに転記する、という作業が重要になることが多い。

となると、転記先のシートでも同じように列番号を列挙体で定義する、という機会が生ずる。

そうなったときに、接頭辞をつけるようにすれば、同名被りをほとんど気にしなくてもよくなるのだ。

たとえば、Sh02View1というシートオブジェクトの1列目に名前、2列目に所属、3列目に戦法を転記するような場合なら、Sh02View1モジュールには、たとえば

Public Enum Sh02ColumnName
  sh02Name = 1
  sh02Prefecture
  sh02Style
End Enum

という列挙体を定義しておけばよい。

Sh01Dataオブジェクトのsh01Name列目のデータはSh02View1オブジェクトのsh02Name列目に転記するということになり、実にわかりやすい。

表全体(項目ラベル含む)のRangeオブジェクトを返すプロパティ

元データからデータを抽出するときには、[Range].AdvancedFilterメソッドを使うと便利。

[Range].AdvancedFilterメソッドを使う際には、[Range]オブジェクトが項目ラベルを持っていないとダメなので、表全体を手軽に取得できればコードが読みやすくなるだろう。

私は次のようなコードで表全体のRangeオブジェクトをシートオブジェクトのプロパティにして、取得しやすくしている。

Public Property Get WholeList() As Range
  Set WholeList = Me.Range("A1").CurrentRegion
End Property

こうしておくことで、項目ラベルを含む表全体を、

Sh01Data.WholeList

という式で他モジュールから参照することができて便利。

表の正味のデータ部分(項目ラベルを含まない表全体)のRangeオブジェクトを返すプロパティ

項目ラベルを含む表全体とは別に、項目ラベルを除いた表の正味のデータ部分も必要。Rangeオブジェクトの1行目がデータの1行目になるから。

[Range].Valueプロパティの返り値をVariant変数に突っ込んだときにできる2次元配列が1始まりの配列になる挙動とも実に相性がよい。

そこで、次のようなプロパティを別途設定する。

Public Property Get DataList() As Range
  Dim ret As Range
  Set ret = Me.Range("A1").CurrentRegion
  If ret.Rows.Count = 1 Then Exit Property
  With ret
    Set ret = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
  End With
  Set DataList = ret
End Property

OffsetプロパティとResizeプロパティを用いて、正味のデータ部分を取り出している。

まあ、元データについてはユーザが触ることは基本ないので、正味の元データ部分に、たとえば「選手データリスト」とでも名前を定義しておいて、

'Declarations Section'
Private Const RACER_DATA_LIST As String = "選手データリスト"

'Properties'
Public Property Get DataList() As Range
  Set DataList = Me.Range(RACER_DATA_LIST)
End Property

で十分だとは思う。もちろん、この場合、表の末尾にデータを追加した場合は範囲の名前定義を修正する必要があるが。

おわりに

シートの列番号と列挙体との相性はきわめてよいので、おすすめです。

つづく……かなあ???