t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

VBA 狙った範囲だけをAutoFitするマクロ

VBA

以下のような表を作ったとき、普通にオートフィットをかけるとA1セルに入力されたタイトルの幅もカウントされてしまい、幅がおかしくなる。
f:id:t-hom:20190306001403p:plain

↓AutoFit後
f:id:t-hom:20190306001709p:plain

今回はこれを何とかするマクロ。

元ネタはこちら。


では、早速コードを紹介しよう。

ただし、注意点として、このマクロはシート上のデータをすべて変数に退避させて一旦消す処理を含むので、マクロがコケた場合は対象データ全消失もありえる。試す場合はくれぐれもファイルを保存してからどうぞ。
念のため言ってるだけなので、実際そんなことにはならないと思うけど。

Sub SmartFit()
    Const MAX_COLUMN_WIDTH = 80
    If TypeName(ActiveSheet) <> "Worksheet" Then
        MsgBox "このマクロはワークシート上で実行してください。", vbExclamation
        Exit Sub
    End If
    
    Dim sh As Worksheet: Set sh = ActiveSheet
    
    Dim targetArea As Range: Set targetArea = Selection.CurrentRegion
    targetArea.Select
    If vbYes <> MsgBox("選択エリアに対してSmartFitを適用しますか？", vbQuestion + vbYesNo, "確認") Then
        MsgBox "キャンセルしました。", vbInformation
        Exit Sub
    End If
    
    
    With sh
        Dim wholeArea As Range: Set wholeArea = .Range(.Cells(1, 1), .Cells.SpecialCells(xlCellTypeLastCell))
        Dim wholeBackup: wholeBackup = wholeArea.Formula
        Dim targetBackup: targetBackup = targetArea.Formula
        
        wholeArea.ClearContents
        targetArea.Formula = targetBackup
        
        Dim zoomLevel As Long
        zoomLevel = ActiveWindow.Zoom
        ActiveWindow.Zoom = 100
        With targetArea
            .EntireColumn.ColumnWidth = MAX_COLUMN_WIDTH
            .EntireRow.AutoFit
            .EntireColumn.AutoFit
        End With
        ActiveWindow.Zoom = zoomLevel
        
        wholeArea.Formula = wholeBackup
    End With
    
    MsgBox "実行しました。", vbInformation
End Sub

使い方

対象の表内の特定セルを選択した状態で実行する。
f:id:t-hom:20190306002236p:plain

※シート内ならどこでも良いわけではなく、実際にオートフィットさせたい表内の任意セルを選ぶこと。例えばタイトルを書いたA1セルを選んで実行すると上手く行かない。CurrentRegionで範囲を決定しているため、表とそれ以外の要素は空行・空列で区切られていなければならない。

実行すると表全体が選択され、この範囲で実行して良いかの確認メッセージが表示される。
f:id:t-hom:20190306002414p:plain

「はい」を選ぶと対象範囲のみを基準にAutoFitされる。

解説

※画像のサイズが不ぞろいなのはご愛敬。。
以下の画像を見ていただけると、大体何をやってるか分かると思う。

f:id:t-hom:20190306003344p:plain

f:id:t-hom:20190306003454p:plain

f:id:t-hom:20190306003802p:plain

f:id:t-hom:20190306003917p:plain

以上

VBA そのマクロ集約、ちょっとまった！

VBA VBAについての考え・意見

たとえば、とあるデータを次のようなステップで加工しているとする。

f:id:t-hom:20190305073629p:plain

それぞれのマクロはボタンを押すだけで完了する。
だったら、わざわざ3つもボタンを押させる意味はあるのか。
普通はそう考える。

そしてボタンを3つ押す作業を一つのボタンに集約する。

f:id:t-hom:20190305073838p:plain

これは本当に良いことなんだろうか？

もちろん、ケースバイケースだとは思うが、私はマクロを作るときに、最悪マクロが動かなくなっても、データの変換が人手でも行えることが重要だと考えている。
中間データをあえて見せることで、加工の過程が明らかになるのであれば、その方が良い。
ボタンを集約してしまうと内部の加工ステップがブラックボックス化し、入力データから出力データへの変換をどうやるのかという手順が想像しづらくなる。

この仕事は何ですか？→ボタンを押すことです。こうなったらおしまいだ。
人がきちんと仕事の意味を考えて仕事を遂行できるようにしておくこと。マクロはあくまで繰り返し行われる単調で面倒くさい作業の緩和や、人が行う作業のミス防止などのサポートに徹するべきだと思う。

マクロを集約したくなったら、ブラックボックス化しないか、作業者がきちんと何をしているか意識して作業できるかを考慮して慎重に行うようにしたい

参考(手前味噌)

thom.hateblo.jp

thom.hateblo.jp

マクロ作成者が覚えておきたい重要な概念「冪等性(べきとうせい)」について

VBA VBAについての考え・意見

冪等性(べきとうせい)とは、ある操作を1回行っても複数回行っても結果が同じであることをいう概念である。
言葉の響きは難しいが、これはプログラマーなら何度も遭遇するシチュエーションなので、是非とも覚えておきたい。

たとえばExcelマクロにおいて、以下のコードは冪等ではない。
実行するたびに、オートフィルターのON / OFFが切り替わってしまうからだ。

Sub NotIdempotent()
    Selection.AutoFilter
End Sub

先日業務であるツールを使用する様子を見たが、そのツールで使われていたオートフィルターを設定するコードは冪等ではなかった。
すると、加工するブックは予めオートフィルターを外しておかなければならない。

冪等性に注意を払ってこのコードを作り直すと、以下のようになる。

Sub Idempotent()
    If Not Selection.Parent.AutoFilterMode Then
        Selection.AutoFilter
    End If
End Sub

選択範囲の親(ワークシート)を確認し、フィルターがかかっていたらそれ以上は実行しないという処理である。
ただこの処理でもまだ詰めが甘い。なぜなら、全く意図しない場所にフィルターが掛かっていたとしても、処理済と見做してしまうからだ。

改良したのがこちらのコード。まず狙った位置にオートフィルターをかけ、もし掛かっていなければ外れたと判断してやり直す。

Sub IdempotentFixed()
    Do
        Selection.AutoFilter
    Loop Until Selection.Parent.AutoFilterMode
End Sub

あるいは、最初からフィルターを解除してしまい、それからフィルターを掛ける。

Sub IdempotentFixed2()
    Selection.Parent.AutoFilterMode = False
    Selection.AutoFilter
End Sub

前者はバグにより無限ループを作らないとも限らないので、最初からフィルターを外す後者の方が良いかもしれない。

いずれのコードも冪等性は確保されている。
この冪等性という概念を知っていると、自分のマクロが冪等性を担保しているかという批判的な眼を養うことができ、より安定したコード作成ができるようになると思う。

注意：今回は簡単に紹介する目的でSelectionを使用していますが、実際に組み込むマクロではRangeやWorksheetを特定して使っています。

VBA 私のコーディング風景垂れ流し動画紹介

VBA クラスモジュール活用

先日Twitterでは公開したんだけど、ツイッターは鍵垢なのでこちらでも公開。

20分くらいあるので倍速再生でも良いかも。

以下に最初に動画内でテキスト入力してる内容を転記したので、1:30まで飛ばしてそこから見ていただけたら良いかと思う。

みなさんこんにちは。
この動画は、私が普段マクロを作成している様子をなるべくそのまま撮影したものです。
趣旨は、「慣れるとこれくらいのスピードで作れるよ」というのを実感してもらうことです。
ノーカットでお送りしますので、固まったように見えたら考え中です。ではつくっていきます。

なんちゃって個人情報から、個別のファイルに転記するマクロです。

※動画データを少しでも軽くするために、画面の解像度をわざと落として録画してるので、その影響で画面配置やイミディエイトウインドウの移動に苦労している。お見苦しいところを申し訳ない。
www.youtube.com

視聴にあたってのオススメポイントは、メタプログラミング。
メタプログラミングってのは、雑に言えば、コードを書くこと自体をプログラミングで行うテクニック。

以下の記事の末尾にメタプログラミングに関する記事のリンクをまとめている。
thom.hateblo.jp

特に、クラスのフィールドを準備するのは結構面倒なので、メタプログラミングを頻繁に使用する。

以上

VBA イミディエイトウインドウを使って簡単にカレンダーを作る方法

VBA

Excelでは色んな方法でカレンダーを作ることができるが、割と面倒くさい。

今回はイミディエイトウインドウを使って、以下のようなカレンダーをサクっと作る方法を紹介。
f:id:t-hom:20190301021717p:plain

まず、曜日を描きたい場所を範囲選択しておく。
f:id:t-hom:20190301022034p:plain

そしてイミディエイトウインドウで次のコードを順に実行する。

n = 1
for each r in selection:r.value = format(n,"aaa"):n=n+1:next

これで曜日の出来上がり。
f:id:t-hom:20190301022934p:plain

次に、下図のように選択する。(選択を開始する位置は、その月の1日の曜日)
f:id:t-hom:20190301023151p:plain

やり方は、Ctrlキーは選択がすべて終わるまで押しっぱなしで、各行をマウスドラッグすればOK。
このときに選択する順は必ず上からになるように注意。
f:id:t-hom:20190301023935p:plain

そして先ほどイミディエイトウインドウに書いたコードを少しだけ修正する。

n = 1
for each r in selection:r.value = n:n=n+1:next

n = 1にカーソルを合わせてEnterで実行し、次の行もEnterで実行すると、ほぼ完成。
f:id:t-hom:20190301024326p:plain

最後に、余分な日付を手動削除しておしまい。

解説

イミディエイトウインドウでは変数宣言こそできないものの、変数への代入は普通にできる。宣言も特に必要ない。
別のプロシージャが実行されるか、明示的にリセットボタン(下図)が押されるまでは有効なので、イミディエイトウインドウでコマンドを入れ続ける間は変数が保持される。
f:id:t-hom:20190301022638p:plain

また、VBAのFormat関数では、format(日付, "aaa")で曜日を取り出すことができる。VBAにおける日付型はDouble型で表され、その整数部が日付、小数部が時刻である。

数値1は1899年12月31日(日)なので、Format(1, "aaa")は日曜日を返す。

?cdate(1)
1899/12/31 
?format(1,"aaa")
日

イミディエイトウインドウでは、一度実行したコードでもカーソルを合わせると編集でき、Enterで再実行できる。実行時はカーソルが行内のどこにあっても構わない。Enterは改行ではなくコード実行になるので注意。改行したい場合はCtrl + Enter。
(マルチラインコードの実行ができるわけではないので改行という表現は微妙。改ステートメントと言ったほうが実態に近い。そんな言葉ないけど。)

For EachにSelectionを渡した場合、セルの選択順に実行される。
セル範囲の場合は1ドラッグを1範囲とみなし、選択した範囲順になる。ただし範囲内の順は左上から右下へ向かう。

分かりやすくテストしたのが以下。
f:id:t-hom:20190301025910p:plain

今これを書きながら気づいたんだけど、以下のように選択しても同じ結果になる。
f:id:t-hom:20190301030255p:plain

こっちの方が楽だ。

以上

VBA 過去直近のX曜日を求めるワンライナーコード

VBA

今回はさくっと短めの記事。

まず過去直近の日曜(当日含む)の日付を求めるコードがこちら。

?date-weekday(date,vbSunday)+1

クエスチョンマークは、イミディエイトウインドウで実行することを想定して書いている。
そして当日を含まない過去直近の日曜の日付を求めるコードはこちら。

?date - weekday(date-1,vbSunday)

どちらも曜日定数を代えると直近のその曜日が取れる。

結論は以上。

ここからは余談

当日を含まない方で、まず私が考えたのがIf文で当日の場合だけ分岐させる方法。

?iif(date = date-weekday(date,vbSunday)+1, date -7, date-weekday(date,vbSunday)+1)

もうちょっと楽にならんかなとTwitterでぼやいたところ、はけた氏より以下のアドバイスをいただいた。

weekdayの中で「date+1」とか「date-1」とか入れたら、簡単になりませんか？

なるほど、賢い。

当日を含めたくないなら、単純に前日起算してやれば良いのだ。
ということで両方のdateから1を引く。

?date-1-weekday(date-1,vbSunday)+1

　-1と+1を相殺して、こう。

?date - weekday(date-1,vbSunday)

完成。

VBA Excelがフリーズするほど大量のデータを特定列の値で分類して別シートに分ける処理

VBA クラスモジュール活用

※注意　今回の記事はアイデアを記したものであり、コードの全体は掲載していません。ヒントを求めている方向けです。答えを求めてる方はごめんなさい。

Excelシートの特定列の値でレコードを分類し、個別のシートに転記する処理を作りたい場合がある。
いつもなら、レコードを1件ずつ読み取りながら転記していく。

ただ、IT運用業務ではサーバーのアクセスログなどの大量データを扱うことがあり、この方法ではどうやってもフリーズしてしまう事態に遭遇した。今回は16万件のレコード。このような大量データを扱う場合、セルに一つずつアクセスする普通のコーディングではExcelが長時間フリーズしてしまう。(大抵、会社のPCというのは普通の事務処理ができれば十分というスペックなので、家のPCよりも酷いことになる。)

ここまでデータがスケールしてしまうと、レコードを1件ずつ読み取る方式では厳しいのだ。

そこで、高速化テクの1つである、動的配列への転記を使うことにした。
thom.hateblo.jp

以下のようにシートから動的配列に転記し、それを分類ごとの動的配列に分け、各シートに転記する方法である。分類ごとの動的配列は分類名(特定列の値)をキーにして辞書型データに持たせることにする。
f:id:t-hom:20190227032305p:plain

ただ、二次元配列はそのまま扱うとやや面倒くさい。
私は普段からレコードをクラスモジュールに入れ、シートに作成したWriteLineメソッドで転記している。

たとえば、Sheet1モジュールに次のようなコードを挿入しておく。

Private Cursor As Long
Sub Init()
    Cursor = 2
End Sub
Sub WriteLine(ParamArray arr())
    For i = LBound(arr) To UBound(arr)
        Cells(Cursor, i + 1).Value = arr(i)
    Next
    Cursor = Cursor + 1
End Sub

すると、標準モジュールからは単にInitしてからWriteLineを実行するだけでデータを順次書き込むことができる。

Sub hoge()
    Sheet1.Init
    For i = Asc("A") To Asc("Z")
        Sheet1.WriteLine i, Chr(i)
    Next
End Sub

書き込み位置を指定するCursorはWriteLineメソッドの内部でインクリメントされるため、書き込みを指示するメインモジュールでは特に書き込み位置を意識しなくて良い。これは楽。

動的配列でもこれと同じ仕組みを使いたい。
そこで、WriteLineを実装したVirtualSheetというクラスを作って動的配列を格納することにした。
f:id:t-hom:20190227034114p:plain

今回、配列の動的拡張も考えていたのだが、二次元配列なので以下の制約があって諦めた。
thom.hateblo.jp

どのみちデータ量が多いので動的配列の拡張を繰り返すのは望ましくない。
そこで、VirtualSheetにInitメソッドを実装し、引数としてあらかじめレコード数を与えて配列サイズを確定させることにした。
分類ごとのレコード数はあらかじめ分類列だけを配列転記し、Dictionaryを使ってカウントしておく。
thom.hateblo.jp


更に、VirtualSheetにWriteToSheetメソッドを実行し、そこに引数で指定したワークシートにデータを書き込む処理を実装した。
f:id:t-hom:20190227035856p:plain

VirtualSheetのコードは以下のとおり。

Private arr()
Private cursor As Long
Const COLUMN_SIZE = 2
Enum Col
    列1 = 1
    列2
End Enum

Sub Init(row_size As Long)
    ReDim arr(1 To row_size, 1 To COLUMN_SIZE)
    cursor = LBound(arr, 1)
End Sub

Sub WriteLine(rc As Record)
    arr(cursor, Col.列1) = rc.列1
    arr(cursor, Col.列2) = rc.列2
    cursor = cursor + 1
End Sub

Sub WriteToSheet(ws As Worksheet)
    ws.Range(ws.Cells(1, 1), ws.Cells(UBound(arr, 1), UBound(arr, 2))).Value = arr
End Sub

今回は汎用性は犠牲にして、カラムサイズを定数で直接VirtualSheetに持たせた。WriteLineも汎用ではなく、Recordクラス型のオブジェクトを受け取って配列に格納するようにした。

Recordクラスは以下のとおり。

Public 列1 As Long
Public 列2 As String
Public Property Get Self() As Object
    Set Self = Me
End Property

最終的なデータ変換のプロセスは以下のようになった。
f:id:t-hom:20190227042753p:plain

これで20万件くらいのデータならなんとか待てるレベル。

今回私が作ったものは全体データは動的配列のまま扱ったが、実際にはSheetモジュールに動的配列を持たせ、GetNextで動的配列から1つずつ、Recordオブジェクトとして取り出す処理をしてたので、実質クラスを使ったのと同じようなことをしている。

いつもはシートからGetNextで取り出しつつ、別のシートにWriteLine。
今回はシートからGetNextで取り出しつつ、VirtualSheetにWriteLine。最後にWriteToSheet。

データ量がどれだけスケールするかによってデータ構造は使い分ける必要がある。
ただし、基本的にデータがスケール際に発生する複雑さをクラスで上手くラップしてやれば、メインロジックはだいたいいつも通りになる。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。