ある表を決められたルールで並び替え ③ 書き出したキーを並び順の数字に置き換え
一昨日からの「並び替えに関する課題」について、少しずつ進めている。
昨日は、並び替えのキーとなる部分を、正規表現を用い抽出して、表の最終列に書き出した。
infoment.hatenablog.com
今日は書き出したキーを、並び替えの順序を示す数字に置き換えてみる。
色々と考えてみたが、今回は並び替えの対応表を作成して、辞書(連想配列)にすることにした。
↓ 「並び順」シートに作成した、「並び順」テーブルがこちら。
これで、辞書を作成してみよう。
Public Property Get SortDict() As Scripting.Dictionary Dim Tb As ListObject Set Tb = Sheets("並び順").ListObjects(1) Dim Dict As Scripting.Dictionary Set Dict = New Scripting.Dictionary Dim ListRow As Excel.ListRow For Each ListRow In Tb.ListRows With ListRow.Range Dict(.Cells(1).Value) = .Cells(2).Value End With Next Set SortDict = Dict End Property
昨日のキー書き出し部をアレンジし、再掲したのがこちら。
Sub 並べ替え() ' 元データ保護のため、シートごとコピーして並べ替え。 Dim Sh(1) As Worksheet ActiveSheet.Copy After:=ActiveSheet Set Sh(0) = ActiveSheet Sh(0).Name = "並べ替え後" ' 正規表現。 Dim myReg As Object Set myReg = CreateObject("VBScript.RegExp") ' パターン定義。 ' 一文字以上の英字のあとに、一回以上連続してスペースが続く。 ' その後に英字が3文字続き、ピリオドののち、商品名となる。 ' 今回必要なのは、英字が3文字続く部分。 myReg.Pattern = "^[A-Z]+\s+([A-Z]{3})\..*$" ' A列をループで確認。キーとなるコードをE列に書き出す。 Dim MC As Object ' MatchCollection Dim Dict As Scripting.Dictionary Set Dict = SortDict Dim r As Range For Each r In Range("A2:A6") If myReg.Test(r) Then Set MC = myReg.Execute(r) Dim temp As String temp = MC(0).SubMatches(0) If Dict.Exists(temp) Then Cells(r.Row, "E") = Dict(temp) End If End If Next End Sub
実行してみると、昨日は三文字のアルファベットだったものが、並び順を示す数字に置き換わっている。
さて、それではいよいよ並べ替え・・・
と行きたいところだが、もう一つやることが有る。
ということで、明日に続きます。
参考まで。
ある表を決められたルールで並び替え ② 正規表現で並び替えキーを書き出し
昨日の「並び替えに関する課題」について、少しずつ進めていく。
infoment.hatenablog.com
昨日のおさらい。並び替えのキーとなる部分は、先頭のアルファベットではなく、その後に続く空白行のさらにあと、連続する3つのアルファベットである。
↓ の例であれば、「AAA」等がそれにあたる。
そこでまず、並び替えのキーとなる情報を正規表現で取得して、別の列に書き出すことにした。
Sub 並べ替え() ' 元データ保護のため、シートごとコピーして並べ替え。 Dim Sh(1) As Worksheet ActiveSheet.Copy After:=ActiveSheet Set Sh(0) = ActiveSheet Sh(0).Name = "並べ替え後" ' 正規表現。 Dim myReg As Object Set myReg = CreateObject("VBScript.RegExp") ' パターン定義。 ' 一文字以上の英字のあとに、一回以上連続してスペースが続く。 ' その後に英字が3文字続き、ピリオドののち、商品名となる。 ' 今回必要なのは、英字が3文字続く部分。 myReg.Pattern = "^[A-Z]+\s+([A-Z]{3})\..*$" ' A列をループで確認。キーとなるコードをE列に書き出す。 Dim MC As Object ' MatchCollection Dim r As Range For Each r In Range("A2:A6") If myReg.Test(r) Then Set MC = myReg.Execute(r) Cells(r.Row, "E") = MC(0).SubMatches(0) End If Next End Sub
結果、E列に並び替え用のキーを書き出すことが出来た。
次回はこの情報を、並び替えに使える形に変換してみる。
明日に続きます。
参考まで。
ある表を決められたルールで並べ替え ① 条件の確認
先日職場で、こんな質問を受けた。
「表を、マクロのボタン一つで並び替えたいんですけど、できますか?」
私は安易に、「できますよ」と答えた。答えてしまった。
思い出しながら、それっぽく表を再現してみるとこうなる。
この表をシステムから取得するたび、毎回手作業で並び替えているとのこと。
条件1
コードの先頭には、何やらアルファベットが付されている。しかも一文字とは限らないらしい。
条件2
その後ろには半角スペースが幾つかあって、しかも「二つ以上」というルール。
条件3
アルファベット3文字と品名が、「.」で繋がっている。
この関係は固定で、例えば、
- AAA.りんご
- BBB.りんご
- AA. りんご
のように、アルファベットが混在したり、文字数が変わることはないとのこと。
これらを踏まえたうえで、以下のように並び替える。
条件4
並び替えは、アルファベット3文字をキーに行う。
しかも、A ⇒ B ⇒ C のようにアルファベット順ではなく、毎回決められた同じ順番で並び替えるとのこと。
条件5
ある決められた行の下に、空白行を幾つか挿入したい。しかも、行数は場所によって異なる。
かなり複雑だが、毎回同じなら
「別シートから、並び替え後の順序で参照しては?」
とも思う。しかし出来ると言った手前、どうやったら出来るか考えてみた。
ということで、数回に分け並び替えてみる。
明日に続きます。
参考まで。
和英併記 ④ 禁断?の方法で併記
昨日はExcel単語帳から、Dictionaryを用いて表を和英併記化してみた。
infoment.hatenablog.com
今日は最終回、禁断のアレを用いて和英併記化に挑戦する。
といっても、実は大したことではない。単に「ふりがな」に英文を表示してみようってだけの話。では、なぜ禁断か。それは、恐らく賛否が分かれると思ったから。
- ふりがなはふりがなであって、英文を書くところではない。
- 情報を流用しにくい。
などなど、色々と反対意見が予想される。
以上を踏まえたうえで行うなら、例えばこんな感じだ。マクロの構成は、ほとんど昨日と同じにしてある。
Sub Sample() ' 辞書(連想配列)作成。 Dim Dict As Object Set Dict = CreateObject("Scripting.Dictionary") Dim r As Range For Each r In Range("C3:D5").Rows With r.Cells ' キー情報は、.Value省略不可注意。 Dict(.Item(1).Value) = .Item(2) End With Next ' 和英併記にする範囲。 Dim TableRange As Range Set TableRange = Range("A3:A6") ' 表の各値を確認。 For Each r In TableRange ' 辞書に存在する単語ならば、ふりがなに英文を設定。 If Dict.Exists(r.Value) Then r.Characters.PhoneticCharacters = Dict(r.Value) Else r.Characters.PhoneticCharacters = "単語帳に無し" End If r.Phonetics.Visible = True Next End Sub
結果は ↓ こちら。
表示 ⇔ 非表示を簡単に切り替えられるので、これはこれでアリかも。
以上、参考まで。
和英併記 ③ Dictionaryで併記
昨日はExcel単語帳から、Findメソッドを用いて表を和英併記化してみた。
infoment.hatenablog.com
今日は、Dictionaryを用いた和英併記化に挑戦する。
折角単語帳があるのだから、ここは辞書(連想配列)で対応したい。
今回の作戦は、こんな感じだ。
- 単語帳で、連想配列作成。
- 表の各単語をループで確認し、単語帳にあれば和英併記化する。
単語帳は、このような構成にしてみた。
・key 日本語
・item 日本語 + 改行 + 英語
Sub Sample() ' 辞書(連想配列)作成。 Dim Dict As Object Set Dict = CreateObject("Scripting.Dictionary") Dim r As Range For Each r In Range("C3:D5").Rows With r.Cells ' 和文と英文を改行で繋いでアイテムとする。 ' キー情報は、.Value省略不可注意。 Dict(.Item(1).Value) = .Item(1) & vbNewLine & .Item(2) End With Next ' 和英併記にする範囲。 Dim TableRange As Range Set TableRange = Range("A3:A6") ' 表の各値を確認。 For Each r In TableRange ' 辞書に存在する単語ならば、和英併記に置き換え。 If Dict.Exists(r.Value) Then r = Dict(r.Value) Else r = r & vbNewLine & "単語帳に無し" End If Next End Sub
結果は、昨日と同じ。
個人的には、Findより、こちらの方が好みだ(単なる好みの話)。
明日に続きます。
参考まで。
和英併記 ② Findで探して併記
昨日はExcel単語帳から、Vlookup関数を用いて表を和英併記化してみた。
infoment.hatenablog.com
今日は、Findメソッドでの和英併記化に挑戦する。
今日の作戦は、こんな感じだ。
- ループで、表の単語を一つずつ調べる。
- 単語帳内で検索し、見つけた場合は、その右隣のセルの値を取得する。
見つからなかった場合は、「単語帳に無し」とする。 - 取得した値を、元の値の後ろにセル内改行で追加する。
Sub Sample() ' 和英併記にする範囲。 Dim TableRange As Range Set TableRange = Range("A3:A6") ' 単語帳の和文列。 Dim DictRange As Range Set DictRange = Range("C3:C5") ' 各単語を和英併記化。 Dim r As Range ' 検索結果。 Dim FindResult As Range For Each r In TableRange ' 完全一致で検索。 Set FindResult = DictRange.Find(What:=r.Value, _ LookAt:=xlWhole) ' 検索結果が存在する場合。 If Not FindResult Is Nothing Then r = r & vbNewLine & FindResult.Offset(, 1) ' 検索結果が存在しない場合。 Else r = r & vbNewLine & "単語帳に無し" End If Next End Sub
結果が ↓ こちら。
割と一般的というか、理解し易い素直な手法ではなかろうか。
ただし、Findメソッドは直前の検索条件を引き継いでしまったり、検索条件を後に残してしまうところが難点だ。
↓ 大文字と小文字、半角と全角、部分一致と完全一致など。
そこで次回は、Findメソッドを用いない方法について紹介します。
参考まで。
和英併記 ① Vlookupで探して併記
Excelで作成した単語帳を活用して、表を和英併記したい。
会社で、そんな要望をいただいた。
そこで、いくつか方法を考えてみた。
具体的には、例えばこんな感じだ。
直ぐに思いつくのは、Vlookupの活用だ。しかしこの場合は併記のため、
そのままでは使用できない。なぜなら式が入力されているセル、つまり
自分自身を検索値にすることはできないから。
そこで、こんな風にしてみた。
併記する内容を別のセルにすることで、ここにVlookupを使う余地が生まれる。
結果、和英併記は一応実現できた。IFERROR関数を用いれば、単語帳に無い
ものは「単語帳に無し」と表記することも出来る。
ただ如何せん、実際に編集してみると分かるのだが、これがひどく面倒くさい。
同一列にデータと数式が交互に入るのは、扱い難いため是非避けたいところ。
ということで、次回以降は、マクロで解決する方法を幾つかご紹介します。
参考まで。