ある表を決められたルールで並び替え ③ 書き出したキーを並び順の数字に置き換え

一昨日からの「並び替えに関する課題」について、少しずつ進めている。
昨日は、並び替えのキーとなる部分を、正規表現を用い抽出して、表の最終列に書き出した。
infoment.hatenablog.com
今日は書き出したキーを、並び替えの順序を示す数字に置き換えてみる。

f:id:Infoment:20200218214814j:plain

色々と考えてみたが、今回は並び替えの対応表を作成して、辞書(連想配列)にすることにした。

↓ 「並び順」シートに作成した、「並び順」テーブルがこちら。
f:id:Infoment:20200218215205p:plain

これで、辞書を作成してみよう。

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

実行してみると、昨日は三文字のアルファベットだったものが、並び順を示す数字に置き換わっている。
f:id:Infoment:20200218215839p:plain

さて、それではいよいよ並べ替え・・・
と行きたいところだが、もう一つやることが有る。

ということで、明日に続きます。

参考まで。

ある表を決められたルールで並び替え ② 正規表現で並び替えキーを書き出し

昨日の「並び替えに関する課題」について、少しずつ進めていく。
infoment.hatenablog.com

昨日のおさらい。並び替えのキーとなる部分は、先頭のアルファベットではなく、その後に続く空白行のさらにあと、連続する3つのアルファベットである。
↓ の例であれば、「AAA」等がそれにあたる。
f:id:Infoment:20200216220910p:plain

そこでまず、並び替えのキーとなる情報を正規表現で取得して、別の列に書き出すことにした。

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列に並び替え用のキーを書き出すことが出来た。
f:id:Infoment:20200217224443p:plain

次回はこの情報を、並び替えに使える形に変換してみる。

明日に続きます。
参考まで。

ある表を決められたルールで並べ替え ① 条件の確認

先日職場で、こんな質問を受けた。

「表を、マクロのボタン一つで並び替えたいんですけど、できますか?」

私は安易に、「できますよ」と答えた。答えてしまった。
f:id:Infoment:20200216215929j:plain

思い出しながら、それっぽく表を再現してみるとこうなる。
f:id:Infoment:20200216220038p:plain
この表をシステムから取得するたび、毎回手作業で並び替えているとのこと。

条件1

コードの先頭には、何やらアルファベットが付されている。しかも一文字とは限らないらしい。
f:id:Infoment:20200216220405p:plain

条件2

その後ろには半角スペースが幾つかあって、しかも「二つ以上」というルール。
f:id:Infoment:20200216220250p:plain

条件3

アルファベット3文字と品名が、「.」で繋がっている。
f:id:Infoment:20200216220516p:plain
この関係は固定で、例えば、

  1. AAA.りんご
  2. BBB.りんご
  3. AA. りんご

のように、アルファベットが混在したり、文字数が変わることはないとのこと。

これらを踏まえたうえで、以下のように並び替える。
f:id:Infoment:20200216220743p:plain

条件4

並び替えは、アルファベット3文字をキーに行う。
f:id:Infoment:20200216220910p:plain
しかも、A ⇒ B ⇒ C のようにアルファベット順ではなく、毎回決められた同じ順番で並び替えるとのこと。

条件5

ある決められた行の下に、空白行を幾つか挿入したい。しかも、行数は場所によって異なる。
f:id:Infoment:20200216221124p:plain

かなり複雑だが、毎回同じなら
「別シートから、並び替え後の順序で参照しては?」
とも思う。しかし出来ると言った手前、どうやったら出来るか考えてみた。

ということで、数回に分け並び替えてみる。

明日に続きます。

参考まで。

和英併記 ④ 禁断?の方法で併記

昨日はExcel単語帳から、Dictionaryを用いて表を和英併記化してみた。
infoment.hatenablog.com
今日は最終回、禁断のアレを用いて和英併記化に挑戦する。
f:id:Infoment:20200214231122j:plain

といっても、実は大したことではない。単に「ふりがな」に英文を表示してみようってだけの話。では、なぜ禁断か。それは、恐らく賛否が分かれると思ったから。

  • ふりがなはふりがなであって、英文を書くところではない。
  • 情報を流用しにくい。

などなど、色々と反対意見が予想される。

以上を踏まえたうえで行うなら、例えばこんな感じだ。マクロの構成は、ほとんど昨日と同じにしてある。

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

結果は ↓ こちら。
f:id:Infoment:20200214231536p:plain

表示 ⇔ 非表示を簡単に切り替えられるので、これはこれでアリかも。

以上、参考まで。

和英併記 ③ Dictionaryで併記

昨日はExcel単語帳から、Findメソッドを用いて表を和英併記化してみた。
infoment.hatenablog.com

今日は、Dictionaryを用いた和英併記化に挑戦する。
f:id:Infoment:20200213225758j:plain

折角単語帳があるのだから、ここは辞書(連想配列)で対応したい。
今回の作戦は、こんな感じだ。

  1. 単語帳で、連想配列作成。
  2. 表の各単語をループで確認し、単語帳にあれば和英併記化する。

単語帳は、このような構成にしてみた。
・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

結果は、昨日と同じ。
f:id:Infoment:20200213231054p:plain

個人的には、Findより、こちらの方が好みだ(単なる好みの話)。

明日に続きます。

参考まで。

和英併記 ② Findで探して併記

昨日はExcel単語帳から、Vlookup関数を用いて表を和英併記化してみた。
infoment.hatenablog.com
今日は、Findメソッドでの和英併記化に挑戦する。
f:id:Infoment:20200212223629j:plain

今日の作戦は、こんな感じだ。

  1. ループで、表の単語を一つずつ調べる。
  2. 単語帳内で検索し、見つけた場合は、その右隣のセルの値を取得する。
    見つからなかった場合は、「単語帳に無し」とする。
  3. 取得した値を、元の値の後ろにセル内改行で追加する。
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

結果が ↓ こちら。
f:id:Infoment:20200212224901p:plain

割と一般的というか、理解し易い素直な手法ではなかろうか。

ただし、Findメソッドは直前の検索条件を引き継いでしまったり、検索条件を後に残してしまうところが難点だ。
↓ 大文字と小文字、半角と全角、部分一致と完全一致など。
f:id:Infoment:20200212225315p:plain

そこで次回は、Findメソッドを用いない方法について紹介します。

参考まで。

和英併記 ① Vlookupで探して併記

Excelで作成した単語帳を活用して、表を和英併記したい。
会社で、そんな要望をいただいた。

そこで、いくつか方法を考えてみた。
f:id:Infoment:20200211214019j:plain

具体的には、例えばこんな感じだ。
f:id:Infoment:20200211214251p:plain

直ぐに思いつくのは、Vlookupの活用だ。しかしこの場合は併記のため、
そのままでは使用できない。なぜなら式が入力されているセル、つまり
自分自身を検索値にすることはできないから。

そこで、こんな風にしてみた。
f:id:Infoment:20200211214651p:plain

併記する内容を別のセルにすることで、ここにVlookupを使う余地が生まれる。
f:id:Infoment:20200211214845p:plain

結果、和英併記は一応実現できた。IFERROR関数を用いれば、単語帳に無い
ものは「単語帳に無し」と表記することも出来る。
f:id:Infoment:20200211215459p:plain

ただ如何せん、実際に編集してみると分かるのだが、これがひどく面倒くさい。
同一列にデータと数式が交互に入るのは、扱い難いため是非避けたいところ。

ということで、次回以降は、マクロで解決する方法を幾つかご紹介します。

参考まで。