テーブル機能の備忘録 ④ 列の追加

先日から、マクロによるテーブル機能の扱いを纏めている（備忘録）。
infoment.hatenablog.com
今日は昨日とほぼ同じで、列についてのご紹介。

テーブルの列を追加する場合、どうすれば良いか。
最も手っ取り早いのは、行の場合と同じだ。列の横に文字を入力すれば、Excelが空気を読んで、良い感じにテーブル範囲を拡張してくれる。

マクロなら、こんな感じだ。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)

        Tb.ListColumns.Add
End Sub

ListRowと同様、列の追加個所を指定することが可能で、戻り値としてListColumnオブジェクトを取得することもできる。この辺りは、昨日とほぼ同じなので割愛。

ところでテーブルが１列目から始まっていない場合のマクロは、どうなるだろう。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)

        Tb.ListColumns.Add 3
End Sub

これを、このテーブルで実行してみる。
シートの三列目ではなく、テーブルの三列目に新たな列が挿入されたことが、見て取れる。

テーブルの起点アドレスを意識する必要が無いので、この仕様は有難い。これは、ListRowの場合も同じだ。

明日に続きます。

参考まで。

テーブル機能の備忘録 ③ 行の追加

先日から、マクロによるテーブル機能の扱いを纏めている（備忘録）。
infoment.hatenablog.com
今日も、昨日のListRowの続きから。

テーブルに一行足したい時、どうすれば良いか。
一番簡単なのは、テーブル範囲の直下に、追加したい文字を入力すること。

あとはExcelが空気を読んで、自動で良い感じにテーブル範囲を拡張してくれる。

しかし、このように集計行が表示されている場合、この方法は使えない。

そんな時は、ListRowsコレクションのAddメソッドが有効だ。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
        ' 一行追加。
        Tb.ListRows.Add
End Sub

↓このように、集計行が表示された状態でも、問題なく一行追加してくれる。

さらに、Addの後ろにスペースを入れると、このように表示される。

[Position]は文字通りポジションで、行を追加する位置を指定できる。
指定しない場合、最下行に追加される。
[Alwaysinsert]は、今回私も初めて知った。TrueまたはFalseを指定する。
Trueの場合、テーブル直下セルに文字があるならば、全体を一行下にシフトする。
Falseの場合、テーブル直下が空白なら上書きし、そうでないならTrueの時と同じ。

また、As ListRowとあるので、ListRowオブジェクトを戻り値として取得できる。
例えば下記サンプルでは、５行目に行挿入したうえで、当該ListRowオブジェクトを変数にセットしている。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
        ' 一行追加。
    Dim ListRow As Excel.ListRow
    Set ListRow = Tb.ListRows.Add(5)
End Sub

ここで、「名前」の列に「桃太郎」と入力したい場合、どのように指定すればよいだろう。名前が２列目であることから、

        ListRow.Range.Cells(2) = "桃太郎"

としても良いが、レイアウト変更で名前が２列目以外に移動してしまうと、間違いのもとになる。そんな時は名前が何列目であるか、以下で取得すると良い。

        Tb.ListColumns("名前").Index

最終的には、↓ のような記述となる。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
        ' 一行追加。
    Dim ListRow As Excel.ListRow
    Set ListRow = Tb.ListRows.Add(5)
        ListRow.Range.Cells(Tb.ListColumns("名前").Index) = "桃太郎"
End Sub

なお、ListRowオブジェクトをセットする変数を設けるのが面倒な場合は、
Withステートメントを使っても良い。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
        ' 一行追加。
    With Tb.ListRows.Add(5)
        .Range.Cells(Tb.ListColumns("名前").Index) = "桃太郎"
    End With
End Sub

どれを用いるかは、時と場合とお好みで。

明日に続きます。

参考まで。

テーブル機能の備忘録 ② テーブルの範囲指定（２）

先日から、マクロによるテーブル機能の扱いを纏めている（備忘録）。
infoment.hatenablog.com
今日も、昨日の続きから。

テーブルでデータを記載する↓「ボディ」部。

昨日の繰り返しになるが、例えばこのように選択できる。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
        
        Tb.DataBodyRange.Select
End Sub

通常のRangeと同様、こちらもループ処理が可能だ。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
        
    Dim r As Range
    Dim i As Long: i = 1
        For Each r In Tb.DataBodyRange
            r.Value = i
            i = i + 1
        Next
End Sub

試しに、各セルに「何番目の処理か」を入力してみた。ループの際は、
列方向が優先されるようだ。

シートがRow（行）がたくさん集まったもの（Application.Rowsプロパティ）であるように、DataBodyRangeもまた、ListRowオブジェクトがたくさん集まったもの（ListRowsコレクション）として扱うことが出来る。

ここで注意が必要なのが、例えばListRows(1)だけでは範囲にならないということ。一行目の範囲を示す場合、ListRowオブジェクトのメンバーであるRangeプロパティまで記載する。

従って、テーブルのデータ範囲の一行目の最初のセルを指定するなら、こうなる。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
        
        ' 以下、３通りを例示。どれでも可。
        Tb.ListRows(1).Range.Range("A1").Select
        Tb.ListRows(1).Range.Cells(1, 1).Select
        ' 一行しかないので、.Cells(1)という表記が可能。
        Tb.ListRows(1).Range.Cells(1).Select
End Sub

次回も、ListRowオブジェクトについてご紹介。
明日に続きます。

参考まで。

テーブル機能の備忘録 ② テーブルの範囲指定（１）

昨日から、マクロによるテーブル機能の扱いを纏めている（備忘録）。
今日は、昨日の続き。

Excelのテーブルについて、その範囲を指定したい場合がある。

テーブルとして書式設定されていないなら、一般的にはこのような感じだろうか。

Sub Test()
    ' アドレスで直接指定。
    Range("A1:D15").Select
    ' 使用範囲で指定。
    Range("A1").CurrentRegion.Select
    ' シートの使用範囲で指定。
    ActiveSheet.UsedRange.Select
End Sub

上記の二つ目と三つ目は、意図しない範囲を指定する場合があるので要注意だ。
またアドレスで指定する場合も、行や列の追加・削除に自動で追従してくれない
ため、こちらも注意が必要となる。

一方で、テーブルの場合はどうだろう。
まず、テーブル全体を指定する場合がこちら。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
        ' テーブル全体を指定。
        Tb.Range.Select
End Sub

テーブルの範囲を指定、ということで、直感的に理解し易いと思う。
また、Excelに限らずお馴染みの

1. ヘッダー（一行目のラベル範囲）
2. ボディ　（データ範囲）
3. フッター（集計行？）

で指定することも可能だ。

ヘッダーを指定して、色を付けてみよう。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)

        Tb.HeaderRowRange.Interior.Color = vbYellow
End Sub

ボディは、このように選択する。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)

        Tb.DataBodyRange.Interior.Color = vbYellow
End Sub

集計行は、こちらをチェックすると表示される。

集計行をフッターと呼んでよいか分からないが、このように指定できる。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
        
        Tb.TotalsRowRange.Interior.Color = vbYellow
End Sub

次回は、行と列の範囲についてご紹介。
明日に続きます。

参考まで。

テーブル機能の備忘録 ① テーブルの指定方法

最近頻繁に、テーブルをマクロで操作することが多くなった。
そこで今回、備忘録を兼ね、テーブルについてまとめてみる。

テーブル機能については、既に多くの方が丁寧に解説されている。
詳細説明は、そちらにお願いするとしよう。

設定方法は実に簡単で、主に以下の二通り。
テーブルとして書式設定する表の一部、又は全てを選択し、以下の何れかを行う。

1. 「テーブルとして書式設定」ボタンを押す
2. Ctrlキーを押しながら、Ｔを押す。

テーブルとして書式設定ボタンは、ホームタブの「条件付き書式」の右隣。
だから、例え正体が分からずとも、普段から見ている人は多いと思う。

ボタンを押して、テーブルに変換する範囲の指定と、先頭行をテーブルの
見出しとして使用するか否かを決める。

見出しとは、この表で言えば一行目の「名前」「ふりがな」など、その列の情報が何を表しているか説明する情報行を指している。大抵は、あった方が都合が良いと思う。

さて、ＶＢＡにおいて、テーブルはListObjectであり、ListObjectsコレクションのメンバーである。だそうな。
docs.microsoft.com

従って、テーブルを変数にセットする場合、変数の型はListObjectまたはValiant（＝何でも入る型）の何れかを選択する。こんな感じだ。

    Dim Tb As Excel.ListObject

「Excel」を省略して、単に

    Dim Tb As ListObject

と書くこともできる。ほとんどの場合は省略されており、私も省略で良いと思う。
※ただし、Word側から操作するなどの場合は省略不可。

ListObjcetは、ListObjcetの集合体、つまりListObjectsコレクションの中の一つだ。
従って変数にセットする際は、以下のように指定する。今回は、二通りのご紹介。

    Dim Tb As Excel.ListObject
    ' 何番目のListObjcetか？で指定する場合。
    Set Tb = ActiveSheet.ListObjects(1)
    ' 名前で指定する場合。
    Set Tb = ActiveSheet.listobjcets("テーブル1")

これ以外の方法も有るかもしれないが、私が知る限りはこの二つ。
何番目？で指定する場合、何番目か知らないと指定できない。シート毎に１番から
始まるので、対象シートにテーブルが一つしかない場合は、前者でも充分か。
※番号は、作成順に附番される。
※テーブルとしての書式設定が解除されたり、削除されると、その後のテーブルは
　番号が自動的に繰り上がる。

テーブルが複数ある場合、名前で指定した方が確実だ。名前は、テーブルデザインタブで確認することが出来る。

こちらで、名前の変更も可能だ。

次回は、テーブルの範囲についてご紹介。
明日に続きます。

参考まで。

フラッシュフィルをマクロの記録で確認

今日初めて、「フラッシュフィル」の存在を知った。

例えば、いつもの「なんちゃって個人情報。

ここに、「ぶっかけ」と追記する。

すると、テーブルが自動で拡張される。
※ここまでは、フラッシュフィルとは関係がなく、テーブルの機能についての話。

ここで、「ぶっかけ」を選んだまま「フラッシュフィル」を押すと・・・

どうやら、「○○・△△派」という言葉のパターンを探し出して、同じルールで抜き出してくれたらしい。

これは何とも便利な機能だ。素晴らしい！ということで、どのような仕組みで実現しているか、マクロの記録で確かめてみた。すると・・・

Range("$N$2").FlashFill

なるほど、これはある意味、潔い。

ちなみに、試してみたところ、思ったほど万能な機能でもなさそうだ。
例えば、「○○・△△派」の「△△」を抽出したかったのだが、意図しないパターンで抽出されてしまった。

理屈の部分が見えないため、100％は信用できないかも。個人的には、正規表現の方が安心感がある（でも面白い機能なので、場面を選んで使ってみよう）。

参考まで。

ある表を決められたルールで並び替え ④ 決められた行に空白行を挿入するには

先日からの「並び替えに関する課題」について、少しずつ進めている。
昨日は、書き出したコードを、並び替え順を表す数字に置き換えてみた。
infoment.hatenablog.com

今日はさらに、決められた行に空白行を挿入してみる。

と言っても、実際に空白行を挿入するのは面倒だ。
そこで、表の下に沢山転がっている空白行を利用する。
昨日の時点で ↓ こうだったものが、

仮にこうなれば、

Ｅ列で並び替えると、↓ こうなる。

後で空白行を挿入する場合と、結果は同じだ。
そこでまず、コードと順位の対照表を更新する。

後は、空白行の順位を追記して、並び替え。
最後に並び替え用の列を削除して、完成だ。

Sub 並べ替え()
    ' 元データ保護のため、シートごとコピーして並べ替え。
    Dim Sh As Worksheet
        ActiveSheet.Copy After:=ActiveSheet
    Set Sh = ActiveSheet
        Sh.Name = "並べ替え後"
        
    ' 正規表現。
    Dim myReg As Object
    Set myReg = CreateObject("VBScript.RegExp")
    ' パターン定義。
    ' 一文字以上の英字のあとに、一回以上連続してスペースが続く。
    ' その後に英字が３文字続き、ピリオドののち、商品名となる。
    ' 今回必要なのは、英字が３文字続く部分。
        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
    
    ' 空白行並び替え用
    Dim arr As Variant
        arr = Array(3, 5, 6)
    
    ' 並び替え用順位の貼り付け。
        Cells(Rows.Count, "E").End(xlUp).Offset(1).Resize(UBound(arr) + 1) = _
            WorksheetFunction.Transpose(arr)
    
    ' 並び替え。
    Dim SortRange As Range
    Set SortRange = Range("A1").CurrentRegion
    
        Sh.Sort.SortFields.Clear
        Sh.Sort.SortFields.Add2 Key:=SortRange.Columns("E:E")
        With Sh.Sort
            .SetRange SortRange
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Columns("E:E").Delete Shift:=xlToLeft
    
        Range("A1").Select
End Sub

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

それでは、ステップ実行で確認してみよう。

これで一応、目的の並び替えが完了した。
なお皆さんご承知のとおり、これは唯一無二の解法ではない。あくまで一つの解答例であるからして、興味のある方は是非他の方法も探ってみて欲しい。

ということで、今回のシリーズは、これでおしまいです。

参考まで。