令和3年秋の叙勲 勲章受章者名簿をどうにかする

令和3年秋の叙勲発表されました。
www.soumu.go.jp

別添「令和3年秋の叙勲 勲章受章者名簿」・・・マジかw

絶対元データあるのだろw　このフォーマットに手打ちしてたらヤバすぎだろwwwww

私、Microsoft Office 2010 しか持っておりませんのでそちらでどうにかしてみます。最新のWordならPDF開けるのかな？　うちは無理でした(´；ω；｀)

InDesign 16.4かーってことくらいしか、わかりませんなｗ

Adobe Acrobat Reader DC インストール (すべてのバージョン)

これでテキストで保存してみますかー。

んーまぁ、これベースでやるしかないっすなぁ。難しいことはしてないのに大変でした(´；ω；｀)

勲章略称表

この表を作りたい。スペース無しで。

該当部分をエクセルに貼り付けてスペースを一括置換(ctrl+h)

B3セルに「=A2」
B2:B3をコピーしてB4:B13に貼り付け。A1でctrl+a→ctrl+c　右クリックで値貼り付け。

なぜか「瑞大」だけ欠けるので手入力。
オートフィルタ→B列空白抽出→行削除

B列選択→区切り位置→固定長で2文字目で区切る

ヘッダーを整えて、おそらく略称が一番右のほうが後でVlookupしやすいので移動する。旭日章忘れてたので同様に処理。

これを勲章略称表とする。

受賞者リスト

なんか別れてる（公務員、行政相談委員、統計調査員／公務員（都道府県職員、市区町村職員等）／公務員、日本郵政公社職員等？）。(；´Д｀)
面倒なので秀丸でテキストファイルを開いてスペース除去して改行を取っ払ってみる。

−ページ数−制御記号を取っ払う。正規表現で「−[0-9]+−.」を改行に置換。
「賞賜主要経歴氏名（年齢）現住所」の前後に改行を入れてみる。
「賞賜都道府県名主要経歴氏名（年齢）現住所」の前後に改行を入れてみる。
連続改行は一つに「\n{2,}」→「\n」

全文コピーしてエクセルの新しいシートに貼ってみる
フィルタで「賞賜」を含む行を削除。下の黄色い行もいらないな・・・と目処を立てて

瑞*と旭*に色を付けてみた

色のない行を削除。ざっと見ると、太字にした2行も不要そうなので削除。

一旦秀丸に戻します。褒章名の前に改行を入れたいので・・・。

連続改行は一つに「\n{2,}」→「\n」。エクセルに貼り付けて左二文字で区分け。

仕上げはvba

はてさてふむー。vbaへ。
正規表現かなぁ・・・。参照設定。

ひらがなが4文字以上続くところをふりがなとしてその最後の位置を返す関数を書いてみる

Function getHiraganaLast(rng As Range) As Integer
    Dim reg As New RegExp
    reg.Pattern = "[あ-ん]{4,}"
    reg.Global = True
    reg.IgnoreCase = True
    Dim re As MatchCollection: Set re = reg.Execute(rng)
    Dim r As Match
    Dim tmp As Integer: tmp = 0
    For Each r In re
        If Not r.Value Like "*かすみがうら*" And Not r.Value Like "*さいたま*" And Not r.Value Like "*つくば*" And r.FirstIndex + r.Length > tmp Then
            tmp = r.FirstIndex + r.Length
        End If
    Next
    getHiraganaLast = tmp
End Function

この関数の戻り値+1以降の文字列を取り出してみる。まぁまぁいい感じかな？

最初「（」「）」で区切れば年齢が取れるかと思ったら（株）とか入ってやんの(´；ω；｀)
コピーして値貼り付けして「（」「）」で区切れば・・・
全角と半角混ざっとるやないか！！！！

さっきの関数応用でひらがなの最初の位置を取得する関数を作って経歴も取れますね！

Function getHiraganaFirst(rng As Range) As Integer
    Dim reg As New RegExp
    reg.Pattern = "[あ-ん]{4,}"
    reg.Global = True
    reg.IgnoreCase = True
    Dim re As MatchCollection: Set re = reg.Execute(rng)
    Dim r As Match
    Dim tmp As Integer: tmp = Len(rng)
    For Each r In re
        If Not r.Value Like "*かすみがうら*" And Not r.Value Like "*さいたま*" And Not r.Value Like "*つくば*" And r.FirstIndex < tmp Then
            tmp = r.FirstIndex
        End If
    Next
    getHiraganaFirst = tmp
End Function

いやはや、普通の表データでくれよ、総務省(´；ω；｀)