技術tips保管庫

技術tips保管庫

Excel VBAを中心に、仕事で役立つあれこれを記録

【Excel VBA】上のセルの文字を下までコピーする

Excel VBA 作業効率化

目次

このページで書くこと

以下のような虫食い状態の表があったとします。

りんごA 美味しい
普通
まずい
りんごB 美味しい
...

それを、このようにすべてのセルに適切な文字が入っている状態にします。

りんごA 美味しい
りんごA 普通
りんごA まずい
りんごB 美味しい
りんごB ...

経緯

上記のような表はなかなかないかもしれませんが、私が働いている会社だと組織図がこの書き方なんですよね。
見やすさを重視した結果なので仕方ないとは思いますが、フィルタリングするときや（「りんごA：美味しい」のように）関数で繋げたいときは面倒です。

作成したもの

以下のように空欄がある組織図を、上のセルの文字で埋めます。

空欄を埋める

使用する前の用意（要確認）

上記の画像を見ていただくとわかるように、表の一番下（A20セル）に「ここまで」と入れてあります。
理由は後述しますが、これを入れておかないと1,048,576行目まで入力されてしまうので入力必須です。
特に、コードをコピーして使用される方はご注意ください。

使用するコード

以下のコードで動いています。

Sub ORG()
'
    Dim OrgSheet As Worksheet
    Dim trgVal As String '対象列
    Dim cellVal As String 'セルの文字列
    Dim rowNum As Long 'セルの行数
    '
    Set OrgSheet = ThisWorkbook.Worksheets("組織図")
    trgVal = "A"
    cellVal = ""
    '
    OrgSheet.Activate
    '
    '1行目から1,048,576行目まで繰り返し
    For rowNum = 1 To 1048576
    '
        '[Ctrl]+[↓]
        OrgSheet.Range(trgVal & rowNum).End(xlDown).Select
        rowNum = ActiveCell.Row
        cellVal = ActiveCell.Value
        '「ここまで」と書いてあったら処理を停止
        If cellVal = "ここまで" Then Exit For
        '次に文字が入っているセルまでにcellValの値を挿入
        Range(trgVal & rowNum, Range(trgVal & rowNum).End(xlDown).Offset(-1)).FillDown
    '
    Next rowNum
'
End Sub

使用上の注意（要確認）

  1. 1行目は必ず見出しにしてください。
  2. 1列ずつ動作させてください（A列とB列を同時に……ということはできません）。
  3. 空欄埋めをする列の最終行の後ろに「ここまで」と入力してください。
  4. 上記コードの8行目（Set OrgSheet = ThisWorkbook.Worksheets("組織図")）の「組織図」を空欄埋めをするシート名に変更してください。
  5. 上記コードの9行目（trgVal = "A"）の「A」を、空欄埋めをする列番号に変更してください。

これで準備OKです。コードを実行してください。

後述しますが、対象のシート名や対象の列はコードに直接書くのではなく、別シートに書いておき、それを参照する方法もあります。

解説

ざっくり

行っている処理についてざっくり言うと、対象列の1行目から[Ctrl]+[↓]キーを押して、次に入力されているセルがどこかを調べ、その間を埋めています。
[Ctrl]+[↓]キーを押しているので、最終行の後ろに「ここまで」と書かないと1,048,576行目まで入力してしまうのです（汗）

詳細

今回の処理にあたってほしいデータは
・対象の列
・コピーする値の文字
・何行目まで処理したか
の3つです（各変数）。

まず、対象列の1行目を選択した状態で[Ctrl]+[↓]キーを押す処理をしています。選択セルは2行目に移ります（OrgSheet.Range(trgVal & rowNum).End(xlDown).Select）。
＊Range.End(xlDown)で[Ctrl]+[↓]

次に、移動した先のセルの値と行番号を控えておきます（rowNum = ActiveCell.Row、cellVal = ActiveCell.Value）。

最後に、現在選択しているセルを基準に、[Ctrl]+[↓]キーを押す処理で次に値が入っているセルを確認し、その上のセルまで一気に埋めます（Range(trgVal & rowNum, Range(trgVal & rowNum).End(xlDown).Offset(-1)).FillDown）。
ここは複雑な書き方をしていますが、

  1. （内側の）Range.End(xlDown)で[Ctrl]+[↓]
  2. Offset(-1)で1つ上の行に移動（Offset(1)で1つ下、Offset(-1)で1つ上の行に移動する）
  3. （外側の）Range.FillDownで範囲内の全セルに挿入

という流れです。

もし、そのときに選択しているセルが「ここまで」のセルだった場合は処理を終了します（If cellVal = "ここまで" Then Exit For）。

上記の処理を1行目から1,048,576行目まで（正しい使い方をすれば「ここまで」のセルまで）繰り返しています（For rowNum = 1 To 1048576）。

もう少し便利にする

今回はコードを直接編集し、対象列や対象のシートを変更しましたが、個人的には操作のためにコードを編集するのは危険だと思います。
そこで、以下のような「設定」というシートを作成し、そこに対象列と対象のシート名を入力するようにしました。

「設定」シート

「設定」シートのB1、B2セルに必要な情報を入力した後、以下のコードを実行することで上記のコードと同様の処理を行います（「設定」シートの情報を反映する処理のみ追加しています）。
＊「ここまで」は入力してください。

Sub ORG()
'
    Dim SetSheet As Worksheet
    Dim orgS As String
    Dim OrgSheet As Worksheet
    Dim trgVal As String '対象列
    Dim cellVal As String 'セルの文字列
    Dim rowNum As Long 'セルの行数
    '
    Set SetSheet = ThisWorkbook.Worksheets("設定")
    orgS = SetSheet.Range("B1").Value
    Set OrgSheet = ThisWorkbook.Worksheets(orgS)
    trgVal = SetSheet.Range("B2").Value
    cellVal = ""
    '
    OrgSheet.Activate
    '
    '1行目から1,048,576行目まで繰り返し
    For rowNum = 1 To 1048576
    '
        '[Ctrl]+[↓]
        OrgSheet.Range(trgVal & rowNum).End(xlDown).Select
        rowNum = ActiveCell.Row
        cellVal = ActiveCell.Value
        '「ここまで」と書いてあったら処理を停止
        If cellVal = "ここまで" Then Exit For
        '次に文字が入っているセルまでにcellValの値を挿入
        Range(trgVal & rowNum, Range(trgVal & rowNum).End(xlDown).Offset(-1)).FillDown
    '
    Next rowNum
'
End Sub

このように設定用のシートを作成しておけば、たとえば複数の列・複数のシートで処理を行いたい場合、編集が楽になります。
誤って必要なコードを消してしまい動作しなくなることもありませんのでオススメです。

以上です。

【Excel VBA】1秒毎に再計算して時間を表示するツール

Excel VBA 作業効率化 ツール

目次

このページで書くこと

終了予定時刻を入力するだけで現在時刻からの時間を計算するツールの仕組みを書きます。
「○時間△分後」と「○分後」のどちらにも対応しています。
タイマーのように残り時間をカウントダウンすることもできます。

経緯

会議などで「○時まで意見出し」のような時間の決め方をすることってありませんか？
パソコンやスマートフォンの機能で測るだけならアラームを使用すればいいだけなのですが、会議ツールや物理的なタイマーだと
まず終了予定時間から今の時間を引き算して、そのあと分に変換して……
みたいな計算が必要になって面倒です。というか私はほぼ必ず計算ミスします。

最近、今さらになってZoomのブレイクアウトルームを使用する機会が増えました。
「○時にこのルームを終了させる」といった感じで設定したいのですが、ブレイクアウトルームではそのような設定ができません。できるのは「○分後に終了」という設定です。速く正確な時間の計算が必要です。そんなの無理です。
なので代わりに計算してくれるツールを作成しました。

作成したツール

B2セル「終了時間」に時間を入力すると自動で計算されます。
D2セル[自動更新]ボタンをクリックするとA2セル「今の時間」や計算結果の変化が1秒毎にわかります。ツールに時間を入力する際の目安にしています。
F2セル[停止]ボタンは自動更新を止めるボタンです。Excelごと終了しても問題ありませんが、いちいち終了するのも面倒なのでつけました。
E3セル[手動更新]ボタンは一度だけ計算を更新させます。

使用画面

また、「終了時間」が「今の時間」より遅い場合は計算しません。

「終了時間」が「今の時間」より遅い場合

ツールは以下のGoogleドライブに保存してあります。ダウンロードしてご使用ください。
drive.google.com

使用するコードと関数

1．関数

1-1．今の時間

以下の関数を入力します。
=TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW()))

今の時間

現在時刻はTIME関数を使用して時分秒を分けて入れます。NOW関数だけで入れられたらよかったのですが、NOW関数は「YYYY/MM/DD HH:MM:SS」の形式のため「終了時間」のセルと計算させる場合は「終了時間」セルも同じ形式で入力しなくてはいけなくなります。
「明日の○時まで」など日付を跨いだ時間設定がしたい場合はその形式がいいと思いますが、私の仕事では日付を跨いで会議をすることがないので省略しました。
反対に、日付を跨いだ時間設定がしたい方はA2セルに「=NOW()」と入力し、B2セルに「YYYY/MM/DD HH:MM:SS」形式で時間を入力するのがいいと思います。
　

1-2．計算結果（時分秒形式）

計算結果は、ただ「終了時間」の値から「今の時間」の値を引いているだけです。
エラー防止のため、「終了時間」の値が「今の時間」の値より大きい場合のみ計算するようにしています。
　
1-2-1．時間
=IF(B2>A2,HOUR(B2-A2),"")

時間の計算結果

　
1-2-2．分
=IF(B2>A2,MINUTE(B2-A2),"")

分の計算結果

　
1-2-3．秒
=IF(B2>A2,SECOND(B2-A2),"")

秒の計算結果

　

1-3．計算結果（分秒形式）

時間を分に直す場合は1時間＝60分として計算しているだけです。
　
1-3-1．分
=IF(B2>A2,(HOUR(B2-A2)*60)+MINUTE(B2-A2),"")

分の計算結果

　
1-3-2．秒
=IF(B2>A2,SECOND(B2-A2),"")
※前述の秒計算と同じです。

秒の計算

2．使用するコード

このツールでは3つのプロージャー（Subのかたまり）を作成しました。
　

2-1．全体

「再計算」「自動更新」「自動更新停止」の3つのプロージャーがあります。
「自動更新」は「再計算」を1秒毎に呼び出すだけの存在です。
複数のプロージャーで使用するため、Date形式の変数「oTime」はパブリックにしてプロージャーの外に出しました。

Public oTime As Date

Sub 再計算()
'
    ActiveSheet.Calculate
'
End Sub

Sub 自動更新()
'
    oTime = Now + TimeValue("00:00:01")
    Call 再計算
    Call Application.OnTime(oTime, "自動更新", , True)
'
End Sub
 
Sub 自動更新停止()
'
    On Error Resume Next
    Call Application.OnTime(oTime, "自動更新", , False)
    '
End Sub

　

2-2．詳細

1-2-1．計算更新
現在表示しているシートの関数の再計算をします。
「ActiveSheet」を別のシート名にすれば特定のシートのみを再計算させることも可能です。

Sub 再計算()
'
    ActiveSheet.Calculate
'
End Sub

　
1-2-2．自動更新
パブリック関数「oTime」に今の時間＋1秒を足して、「再計算」プロージャーを実行します。
その後OnTimeメソッドで自身を呼び出し、再度1秒足して「再計算」を実行します。
OnTimeメソッドは以下の形式です。
OnTime (EarliestTime, Procedure, LatestTime, Schedule)

EarliestTime 開始時間（ここでは「oTime」）
Procedure 実行するプロージャー（ここでは「再計算」）
LatestTime 終了時間（ここでは指定していません）
Schedule OnTimeメソッドを実行する場合は「True」、実行中のOnTimeメソッドを停止させる場合は「False」です。「True」の場合は省略可能

　

Sub 自動更新()
'
    oTime = Now + TimeValue("00:00:01")
    Call 再計算
    Call Application.OnTime(oTime, "自動更新", , True)
'
End Sub

※参考
Application.OnTime メソッド (Excel) | Microsoft Docs
　
1-2-3．自動更新停止
OnTimeメソッドで繰り返している「自動更新」プロージャーを停止させます。
「自動更新」プロージャーでは「True」だった「Schedule」パラメーターを「False」に変更します。
当然ですが「EarliestTime」と「Procedure」は停止させたいプロージャーに書かれているOnTimeメソッドと同じものを書かなければ停止しません。
「On Error Resume Next」はエラーが発生しても次のステートメント（ここでは「Call」以降）から実行させるために書いています。これでなにかエラーが発生していてもとりあえず停止してくれます。

Sub 自動更新停止()
'
    On Error Resume Next
    Call Application.OnTime(oTime, "自動更新", , False)
    '
End Sub

まとめ

本当はこんなことをしなくてもツール側でいい感じにしてほしいです。

封書を郵送するときのテンプレート（宛名シート・送り状）

作業効率化 ツール

目次

このページで書くこと

封書を郵送する際に必要なものをまとめます。
テンプレートを持っておくと急な作業にもすぐに対応できていいですね。

テンプレート

1. 宛名シート

URLはGoogleドライブの「宛名シート.xlsx」にリンクしています。
xlsx形式でダウンドードして使ってください。
docs.google.com

シートの構成は以下の通りです。

宛名シート（入力） パソコンで入力した宛名を印刷して使用するシートです。
宛名シート（手書き） 空の状態で印刷し、宛名を手書きするためのシートです。
宛名シート（記入例） 手書きの見本です。
入力用

定例作業等で繰り返し同じ場所に送る場合は、住所を貼るだけにしておくと便利です。

パソコンで宛名を入力のうえ、印刷してご使用ください。

入力用

1ページ目に宛先、2ページ目に切り取り線を入れています。
印刷の際はA4用紙で、長辺綴じの両面印刷をすると、宛名の面を綺麗に保ったまま、ハサミで簡単に切ることができます。

※問題なく印刷できることは確認済みですが、念のためご使用の環境で試し刷りをしてからご使用ください。

手書き用

送付するものの形状などによっては、直接宛名を書くことが憚られる場合もあります。
手書き用の宛名シートも持っておいて損はありません。

また、入力用よりも大きな枠を設けているため、パソコンで宛名を入力し、大きな宛名シートとして使用することも可能です。

手書き用

2. 送り状

B5サイズ

URLはGoogleドライブの「送付状_B5.docx」にリンクしています。
docx形式でダウンドードして使ってください。
docs.google.com
そこまでかしこまったものではないが、紙を1枚だけ封筒に入れるのも憚られる……というときにお使いください。
小さですが、最低限必要な項目は揃えてあります。

f:id:arekoretips:20210819004954p:plain
B5サイズ

1ページ目に宛先、2ページ目に切り取り線を入れています。
印刷の際はA4用紙で、長辺綴じの両面印刷をすると、宛名の面を綺麗に保ったまま、ハサミで簡単に切ることができます。

A4サイズ

URLはGoogleドライブの「送付状_A4.docx」にリンクしています。
docx形式でダウンドードして使ってください。
docs.google.com
よりしっかりとした送り状で送りたいときにお使いください。
企業間のやり取りでも問題なく使用できます。

A4サイズ

※問題なく印刷できることは確認済みですが、念のためご使用の環境で試し刷りをしてからご使用ください。

3.三つ折りツール

URLはGoogleドライブの「3つ折_A4.docx」にリンクしています。
docx形式でダウンドードして使ってください。
docs.google.com
A4の書類を長方形の封筒に入れる際には三つ折りにして入れるのが一般的だと思いますが、少しずつ調整しながら折ったり、それでも少しずれてしまったり、なかなか効率が悪い作業だと思います。

なので折るときの基準になる紙を用意しました。
この紙をA4用紙で印刷し、「上」と書いている短辺を書類の上部に合わせてください。
そのまま、書類の裏面に線が透けると思いますので、その線に沿って鉛筆などで数カ所印をつけ、その印に沿って折れば完成です。
書類を折った後は、裏の印を消しゴムで消してください。

※この紙自体は折らない方が使いやすいです。

三つ折りツール

ちなみに、書類を三つ折りにする際は相手の宛名がある方の短辺を上にします。
封筒に入れる際も、相手の宛名が下にならないように入れてあれば問題ありません。
（そこまで細かくチェックして封筒を開ける人なんて相当の物好きです）

※本記事に登場する会社名、人名はすべて架空のものです。実在しませんのでご注意ください。

以上です。

【Excel VBA】文字列とセルの塗り潰しの色を同時に集計するオリジナル関数を作る

Excel VBA 作業効率化 オリジナル関数

目次

このページで書くこと

文字列とセルの塗り潰しの色を同時に集計するオリジナル関数を作ります。

経緯

さっそくなのですが、職場にこのような表はありませんか？

セルの塗り潰しで状況を分けている表

予定や状況をセルの塗り潰しの色で分けている表です。

そしてその表をこのような感じで集計しなければいけないときはありませんか？

文字列とセルの塗り潰しの色を同時に集計する

たとえば、完了なら「1」、延期なら「2」、未定は「3」とフラグが立ててあれば集計はCOUNTIFS関数で簡単にできるのですが、当然ながらCOUNTIFS関数ではセルの塗り潰しの色で集計することはできません。

なら、集計しやすいように表を変えてしまえばいいのかと言うと、そうでもないのです。
フラグで状況が表されている表って、ぱっと見て全体像を把握しにくいんですよね。
色分けしてある表は、人間にとってはとても読みやすいものだと思います。

でも手作業で数えて集計なんてやってられません。
なので、色と文字を同時に集計できるオリジナル関数を作りました。

使用するデータ

上で出した表をサンプルデータとして使用します。
「【Excel VBA】Excelでツールファイルを作る」というページで制作したデータを流用しています。
arekoretips.hatenablog.jp

使用するコード

今回は「Sub」ではなく「Function」です。
引数の部分が、実際に関数を使用するときの選択セルになります。

Function CountColor(集計色範囲 As Range, 条件色セル As Range, 集計範囲 As Range, 条件セル As Range)
    Application.Volatile
    '
    CountColor = 0
    '
    Dim y, x, i
    For y = 1 To 集計色範囲.Columns.Count
        For x = 1 To 集計色範囲.Rows.Count
            If 集計色範囲.Rows(x).Columns(y).Interior.Color = 条件色セル.Interior.Color Then
                For i = 1 To 集計範囲.Columns.Count
                    If 集計範囲.Rows(x).Columns(i).Value = 条件セル.Value Then
                        CountColor = CountColor + 1
                    End If
                Next i
            End If
        Next x
    Next y
End Function

関数の使い方

引数のネーミングセンスが悪く、なにをどう使えばいいのか謎だと思いますので、使い方の解説をします。

集計色範囲 集計したい色の範囲
条件色セル 集計したい色のセル
集計範囲 集計したい文字の範囲
条件セル 集計したい文字のセル
「県別」シート
「集計」シート

なので、たとえば今回のような集計をしたい場合は、以下のような書き方になります。

CountColor(集計色範囲,条件色セル,集計範囲,条件セル)
↓つまり↓
CountColor(県別!$D$2:$D$34,県別!$F$2,県別!$B$2:$B$34,$B2)

備考

「Application.Volatile」はこのマクロを通常の関数のように動かしてくれるメソッドです（正確には「Volatile」がメソッドです）。
集計範囲内のセルの色を変更したり、セルの値を変更したときに自動で計算し直してくれるのはこのメソッドのおかげです。

次に選択した「集計色範囲」がどの範囲なのかを認識させています（For y = 1 To 集計色範囲.Columns.Count、For x = 1 To 集計色範囲.Rows.Count）。
ここの「1」はつまり、1番目に選択したセル（D2セル）ということです。

そして決められた範囲に選択したセルと同じ色のセルがあったら（If 集計色範囲.Rows(x).Columns(y).Interior.Color = 条件色セル.Interior.Color Then）、次のFor文に移ります。

「集計範囲」の部分でも、やっていることは「集計色範囲」と同じです。
ただし、「集計色範囲」と「集計範囲」の行は同じにしなければ正しく集計できないので、先ほど認識させた「集計色範囲」のRowの値を再利用します（集計範囲.Rows(x)）。

今度も先ほどと同じように、決められた範囲に選択したセルと同じ値のセルがあるかをチェックします（If 集計範囲.Rows(x).Columns(i).Value = 条件セル.Value Then）。

この条件をすべてクリアするとようやく1数えられるというわけです（CountColor = CountColor + 1）。

処理後は、拡張子の修正（xlsm→xlsx）を忘れずに！

以上です。

【Excel VBA】Excelでツールファイルを作る

Excel VBA 作業効率化 ツール

目次

このページで書くこと

どのExcelファイルでも使用できる「ツールファイル」を作成します。
このファイルの「設定」シートに対象のExcelファイルの名前やシート名を入力して実行する、という使い方を想定しています。

経緯

会社で仕事をしていると、共有のフォルダに保存されたExcelファイルというものが必ずあると思います。
そういうファイルって、部署の決まりで「xlsm」形式の保存がNGの場合もあるので少し厄介です。
編集するときはファイルをコピーして、古いファイルはバックアップとして「old」フォルダに移動させる、という方法も多いですよね。
もちろん都度VBAを消したり修正したりすればいいだけの話ですが、何回もやるのは面倒……。
なので、必要な処理を外に出してみました。

使用するデータ

以下のようなExcelのサンプルデータを使用します。
「生産量」ファイルはくだものの数が少ないので問題なさそうですが、行数が増えると面倒そうです。
「県別生産数」ファイルはデータが多いうえにバラバラでストレスフルな仕上がりです。

「生産量」ファイル
「県別生産数」ファイル

用意

①「xlsm」ファイルを作ります。
②シート名は「設定」とでもしておきます（なんでもいいです）。
③ファイル名、シート名など、必要な情報を入力するセルを決めておきます。
④必要に応じてボタンなどをつけておきます（あとでマクロを設定します）。

「設定」シート

使用するコード

セルに入力されたファイル情報を取得し、Workbook型やWorksheet型の変数に代入します。

ファイル名取得
→取得したファイル名をString型の変数に代入
→変数を使ってWorkbookやWorksheetを定義

の流れです。
あとはWorkbook型やWorksheet型の変数を使ってコードを書くだけです。

Dim SetSheet As Worksheet 'ツールファイルの「設定」シート
Dim dataA As Worksheet '対象ファイルA
Dim aBook As String '「設定」シートのB5セル（対象ファイルAの名前）
Dim aSheet As String '「設定」シートのB6セル（対象ファイルAのシート名）
'
Set SetSheet = ThisWorkbook.Worksheets("設定")
aBook = SetSheet.Range("B5").Value
aSheet = SetSheet.Range("B6").Value
Set dataA = Workbooks(aBook).Worksheets(aSheet)

コードの例

普段使っている雰囲気のコードです。

例①

以前書いたExcelブック内の全シートをA1セル選択にするコードの汎用版です。
「設定」シートのB2セルに対象のファイル名を入力すればワンクリックで動作します。
arekoretips.hatenablog.jp

Sub UPPER_LEFT()
'
    Dim SetSheet As Worksheet 'ツールファイルの「設定」シート
    Dim dataB As String '「設定」シートのB2セル（対象ファイル名）
    Dim DataBook As Workbook '対象ファイル
    '
    Set SetSheet = ThisWorkbook.Worksheets("設定")
    dataB = SetSheet.Range("B2").Value
    Set DataBook = Workbooks(dataB)
    '
    DataBook.Activate
    '
    Application.ScreenUpdating = False '画面の更新を停止させる
    '
    Dim i As Long
    For i = 1 To Worksheets.Count
        Sheets(i).Activate
        ActiveWindow.ScrollColumn = 1 'A列が左側に来るように調整
        ActiveWindow.ScrollRow = 1 '1行目が一番上に来るように調整
        Range("A1").Select 'A1セルを選択
    Next i
    '
    Sheets(1).Activate '先頭のシートを表示
'
Application.ScreenUpdating = True '画面の更新を戻す
'
End Sub
バラバラのシート
画面が整う

例②

Aのファイルで選択した文字列で、AとBのファイルをフィルタリングします。
なにに使用するのか不明かもしれませんが、たまにこの処理が必要になるときがあります。
arekoretips.hatenablog.jp
arekoretips.hatenablog.jp

Sub AtoB()
'
    Dim SetSheet As Worksheet 'ツールファイルの「設定」シート
    Dim dataA As Worksheet '対象ファイルA
    Dim aBook As String '「設定」シートのB5セル（対象ファイルAの名前）
    Dim aSheet As String '「設定」シートのB6セル（対象ファイルAのシート名）
    Dim dataB As Worksheet '対象ファイルB
    Dim bBook As String '「設定」シートのB7セル（対象ファイルBの名前）
    Dim bSheet As String '「設定」シートのB8セル（対象ファイルBのシート名）
    Dim fruitsName  As String 'フィルタリングする文字列
    '
    Set SetSheet = ThisWorkbook.Worksheets("設定")
    aBook = SetSheet.Range("B5").Value
    aSheet = SetSheet.Range("B6").Value
    bBook = SetSheet.Range("B7").Value
    bSheet = SetSheet.Range("B8").Value
    Set dataA = Workbooks(aBook).Worksheets(aSheet)
    Set dataB = Workbooks(bBook).Worksheets(bSheet)
    '
    dataA.Activate  'ファイルAをアクティブにする
    fruitsName = ActiveCell.Value 'ファイルAのアクティブセルの値を変数に代入
    dataA.AutoFilterMode = False 'オートフィルタ が有効なら無効にする（エラー防止）
    dataA.Rows(1).AutoFilter Field:=2, Criteria1:=fruitsName 'ファイルAの1行目B列を「fruitsName」でフィルタリング
    '
    dataB.Activate 'ファイルBをアクティブにする
    dataB.AutoFilterMode = False 'オートフィルタ が有効なら無効にする（エラー防止）
    dataB.Rows(1).AutoFilter Field:=2, Criteria1:=fruitsName 'ファイルBの1行目B列を「fruitsName」でフィルタリング
'
End Sub
ファイルAのセルを選択した状態で実行する。
ファイルAとファイルBが選択した文字列でフィルタリングされる。

以上です。

【Excel VBA】オートフィルタ後に表示されたセルを選択させる

Excel VBA 作業効率化

目次

このページで書くこと

Excel VBAでオートフィルタを使用した際、表示された結果が0件かどうかを判別させます。
0件の場合はその旨のポップアップを表示させ、1件以上の場合はその結果の最終行の任意のセルを選択させます。

経緯

以前、少し厄介なデータを手作業で集計した際、

資料Aの1のデータをコピー
→コピーしたデータを資料Bのオートフィルタで検索
→オートフィルタの結果が1件なら作業A、2件以上なら作業B、0件なら作業C
→資料Aの2のでデータをコピー
→……
→資料Aの100のでデータをコピー
→……

といった内容の作業をしなければいけないことがありました。

ただでさえ面倒で仕方がないのに、手作業でのコピーや目視の確認では表示位置のズレなどで間違いも起こりやすく、作業中も不安でした。

なので、少しでも間違いを減らすために

[実行]ボタンクリック
→資料Aで選択中のセルのデータを読み取る
→読み取ったデータを資料Bでオートフィルタ
→オートフィルタの結果が1件なら、その行のデータAをコピー、0件ならその旨のポップアップを出す

というマクロを組みました。

しかし、オートフィルタの結果を数字で認識させるのって難しいんですよね。
結構苦戦しましたので、後学のためにコードを残しておきます。

通常はフィルタリングしても選択セルは移動しない

使用するデータ

以下のようなExcelのサンプルデータを使用します。
「【Excel VBA】オートフィルタを操作する」というページで制作したデータを流用します。
arekoretips.hatenablog.jp

サンプルデータ

使用するコード

B2セルの「山田勇気」を選択した状態で下記のマクロを動作させると、以下のようにフィルタリングした一覧の最終行のA列（A25セル）を選択しています。

フィルタリングした一覧の最終行のA列（A25セル）を選択する

ためしにA1セル（「日付」）を選択した状態でマクロを動作させると、B列に「日付」と入力されたセルはないため「該当なし」のポップアップが表示されます。

「該当なし」のポップアップ
Sub AUTOFIL_CEL()
    '
    Dim keyWord As String
    Dim filterRow As Long
    '
    keyWord = ActiveCell.Value
    '
    '「成績表」シートの1行目のB列を選択中のセルの値でフィルタリング
    Worksheets("成績表").Rows(1).AutoFilter Field:=2, Criteria1:=keyWord
    'フィルタリングされた表の最終表示行を取得
    filterRow = Cells(Rows.Count, 1).End(xlUp).Row
    '
    '0件の場合は「該当なし」とメッセージを表示させる
    If filterRow = 1 Then MsgBox "該当なし"
    '
    'フィルタリングされた表の最終行を選択する
    Range("A" & filterRow).Select
'
End Sub

解説

まず変数「keyWord」に選択中のセルの値を入れます（ActiveCell.Value）。
別シートや別ブックの値の場合はその旨を指定すれば問題ありません。

次に「 成績表」シートの1行目（Rows(1)）のB列（Field:=2）を選択中のセルの値でフィルタリングします。

フィルタリングされた表の最終表示行を取得するために、まずシートの最終行を取得します（Rows.Count）。
シートの最終行というのはつまり、多くのExcelのバージョンでは1,048,576行目（2の20乗）のことです。

そして最終行のA列（Cells(Rows.Count, 1)）から、データが入力されているセルまで移動します（End(xlUp)）。
※「End(xlUp)」はキーボードのショートカットの[ctrl] + ↑の動きです。

変数「filterRow」には、移動した先の行番号を格納しておきます（.Row）。

もし移動した先が1行目だった場合は、項目行しか存在しないことになりますので、フィルタリングの結果は0件です（If filterRow = 1）。

それ以外の場合は何かしらの検索結果が出ているはずなので、最後に移動した先の行番号のA列のセルをアクティブにします（Range("A" & filterRow).Select）。

備考

シートの最終行（Rows.Count）確認のためにこのようなテストマクロを書きました。

 Sub ROWS_TEST()
 '
    MsgBox Rows.Count
 '
 End Sub

結果は以下の通りです。

1048576が表示される

以上です。

【Excel VBA】オートフィルタを操作する

Excel VBA 作業効率化

目次

このページで書くこと

Excel VBAでオートフィルタを使用する際の書き方や注意点を、実務に照らして書きます。
数値や文字列でのフィルタリングを一通りできるようにすることが目標です。

経緯

Excel VBAのオートフィルタには多くの機能がありますが、実際に使用するのはごく一部の機能だけです。
数値と文字列でフィルタリングできれば、実務ではほぼ困りません。

しかし、よく使う機能のみを簡単にまとめたサイトがなかなか見つからないので、このページにまとめました。

使用するデータ

Excelで以下のようなサンプルデータを作成しました。
特筆すべき点としては「山田勇気」と「山田勉」の、二人の山田さんがいます。

サンプルデータ

使用するコード

ベーシックなフィルタリング

「成績表」シートの1行目（Rows(1)）のB列（Field:=2）を「山田勇気」でフィルタリングします。
※「山田勇気」の行のみが表示されます。

1行目のB列を「山田勇気」でフィルタリング
Sub AUTOFIL()
'
    Dim keyWord As String
    '
    keyWord = "山田勇気"
    '
    '「成績表」シートの1行目のB列を「山田勇気」でフィルタリングする
    Worksheets("成績表").Rows(1).AutoFilter Field:=2, Criteria1:=keyWord
'
End Sub

省略した書き方

上のコードの省略版です。
「Field:=」や「Criteria1:=」は書かなくても動作上問題ありません。
※私はあとでわかりやすいように書いていますので、以降はすべて省略せずに書いていきます。

Sub AUTOFIL_2()
'
    Dim keyWord As String
    '
    keyWord = "山田勇気"
    '
    '「成績表」シートの1行目のB列を「山田勇気」でフィルタリングする
    Worksheets("成績表").Rows(1).AutoFilter 2, keyWord
'
End Sub

ワイルドカードを用いたフィルタリング

「*」を使えば「〇〇を含む」や「〇〇から始まる」といった検索方法も可能です。

*〇〇 〇〇で終わる
〇〇* 〇〇から始まる
*〇〇* ○○を含む

「成績表」シートの1行目（Rows(1)）のB列（Field:=2）を「山田を含む」で フィルタリングします。
※「山田勇気」と「山田勉」の行が表示されます。

1行目のB列を「山田を含む」で フィルタリング
Sub AUTOFIL_WILD()
'
    Dim keyWord As String
    '
    keyWord = "山田"
    '
    '「成績表」シートの1行目のB列を「山田を含む」で フィルタリングする
    Worksheets("成績表").Rows(1).AutoFilter Field:=2, Criteria1:="*" & keyWord & "*"
'
End Sub

複数条件でフィルタリング

「Criteria」は「Criteria1」「Criteria2」と繋げることでフィルタリングの条件を追加することができます。
その際、「Operator」に指定する定数を変更することで、And検索やOr検索が可能です。

xlAnd 条件A且つ条件B
xlOr 条件Aまたは条件B

「成績表」シートの1行目（Rows(1)）のB列（Field:=2）を「山田を含む」か「佐藤淳」でフィルタリングします。
※「山田勇気」「山田勉」「佐藤淳」の行が表示されます。

1行目のB列を「山田を含む」か「佐藤淳」でフィルタリング
Sub AUTOFIL_MULT()
'
    Dim keyWord As String
    Dim keyWord2 As String
    '
    keyWord = "山田"
    keyWord2 = "佐藤淳"
    '
    '「成績表」シートの1行目のB列を「山田を含む」か「佐藤淳」でフィルタリングする
    Worksheets("成績表").Rows(1).AutoFilter Field:=2, _
        Criteria1:="*" & keyWord & "*", Operator:=xlOr, _
        Criteria2:=keyWord2
'
End Sub

配列を使ったフィルタリング

複数条件でフィルタリングする場合は、配列を使うこともできます。

「成績表」シートの1行目（Rows(1)）のB列（Field:=2）を「山田勇気」「佐藤淳」「鈴木由美」でフィルタリングします。
※「山田勇気」「佐藤淳」「鈴木由美」の行が表示されます。

配列を使う場合は大切な約束事があります。
「AutoFilter」の引数に「Operator:=xlFilterValues」を入れるということです。
「xlFilterValues」はフィルターの値を指定するものなのですが、これを指定すると、配列の中身がフィルタリングの要素として解釈されるようになります。

1行目のB列を「山田勇気」「佐藤淳」「鈴木由美」でフィルタリング
Sub AUTOFIL_ARR()
'
    Dim keyArray(2) As String
    '
    keyArray(0) = "山田勇気"
    keyArray(1) = "佐藤淳"
    keyArray(2) = "鈴木由美"
    '
    '「成績表」シートの1行目のB列を「山田勇気」「佐藤淳」「鈴木由美」でフィルタリングする
    Worksheets("成績表").Rows(1).AutoFilter Field:=2, Criteria1:=keyArray, Operator:=xlFilterValues
'
End Sub

「○○以外」でフィルタリング

「Criteria」は、なにも指定しなければ自動的に「＝」として指定された情報を処理してくれますが、こちらで処理の方法を指定することもできます。

<>〇〇 〇〇以外
<>*〇〇* 〇〇を含まない
>〇〇 〇〇より大きい（〇〇を含まない）
>=〇〇 〇〇以上（〇〇を含む）
<〇〇 〇〇より小さい（〇〇を含まない）
<=〇〇 〇〇以下（〇〇を含む）

複数条件のフィルタリングと組み合わせて、「年齢が30歳以上且つ、40歳未満」といった絞り込みも可能です。

「成績表」シートの1行目（Rows(1)）のB列（Field:=2）を「山田勇気以外」でフィルタリングします。
※「山田勇気」の行は表示されません（「山田勉」は表示されます）。

1行目のB列を「山田勇気以外」でフィルタリング
Sub AUTOFIL_OTHER()
'
    Dim keyWord As String
    '
    keyWord = "山田勇気"
    '
    '「成績表」シートの1行目のB列を「山田勇気以外」でフィルタリングする
    Worksheets("成績表").Rows(1).AutoFilter Field:=2, Criteria1:="<>" & keyWord
'
End Sub

複数列のフィルタリング

複数の列でフィルタリングしたい場合は、「With」を使って2つの「AutoFilter」を繋げてしまうと簡単にできます。

「成績表」シートの1行目（Rows(1)）のB列（Field:=2）を「山田勇気」で、C列（Field:=3）を「商品A」でフィルタリングします。
※「山田勇気」の「商品A」の行のみが表示されます。

1行目のB列を「山田勇気」で、C列を「商品A」でフィルタリング
Sub AUTOFIL_COL()
'
    Dim keyWord As String
    Dim keyWord2 As String
    '
    keyWord = "山田勇気"
    keyWord2 = "商品A"
    '
    '「成績表」シートの1行目のB列を「山田勇気」でフィルタリングする
    '「成績表」シートの1行目のC列を「商品A」でフィルタリングする
     With Worksheets("成績表").Rows(1)
        .AutoFilter Field:=2, Criteria1:=keyWord
        .AutoFilter Field:=3, Criteria1:=keyWord2
     End With
'
End Sub

フィルタリングを解除

設定しているフィルタリングを解除します。
フィルタリングされていない状態で実行しても、変化はありません。

Sub AUTOFIL_ALL()
'
    '全選択の状態にする
    If Worksheets("成績表").FilterMode Then Worksheets("成績表").ShowAllData
'
End Sub

まとめ

  • 「Field:=」や「Criteria1:=」は省略可能
  • 「Operator」に「xlAnd」や「xlOr」を指定することでAnd検索やOr検索が可能
  • 条件に配列が使える（「Operator:=xlFilterValues」を忘れずに）
  • 「〇〇以外」「〇〇以上」などの条件の指定が可能
  • 複数の列でフィルタリングしたい場合は、「With」を使って「AutoFilter」を繋げると楽

以上です。