基幹システムや会計システム等からExcelやCSV形式でデータを出力することも多いと思います。
それらのシステムから出力したデータは、通常は何も加工されておりませんので、フィルターもかかっておらず、列幅すら調整されていない(=データの内容がそのままでは文字列等が途切れて全文視認できない)ことも多いでしょう。
何か単発的な必要(例えば問い合わせ対応)のために、対象のデータ行を発見するには、データを出力してフィルター等で加工を加えます。
単発的な必要のために行うときは、凝った加工等は必要ありませんが、それでもフィルターの設定等には手間がかかります。
素早くデータを見やすく加工するための選択肢の一つは、テーブル化することです。
テーブル化したいデータエリアのどこかのセルをアクティブな状態で、CTRL+Tでテーブル化でき、自動でフィルターも設定されます。
しかし、例えばデータの列が数十~数百列あるような場合は、テーブル化しても見づらいです。
そこで、下記を一括で行うマクロを紹介します。
- オートフィルター
- 列幅調整
- 見出し以外にデータがない列をグループ化(ヘッダーのみで何も入力されていない列)
- ウィンドウ枠の固定
コード
Sub sbデータ整形()
'オートフィルター&列幅調整&見出し以外にデータがない列をグループ化&ウィンドウ枠の固定
Dim headerRow As Variant '見出し行数をInputBoxで入力するための変数
Dim j As Long '列カウンター
Dim lastColomns As Long
Dim bordersFlg As VbMsgBoxResult '罫線はつけるかのフラグ
Application.ScreenUpdating = False '画面更新の停止
Dim ws As Worksheet
Set ws = ActiveWorkbook.ActiveSheet 'ActiveSheetをwsに設定
With ws
headerRow = Application.InputBox( _
PROMPT:="見出し行数を入力してください。" & vbCrLf & "(1未満の数値を入力した場合は、1として扱います。)", _
TITLE:="見出し行数入力", _
Type:=1)
If TypeName(headerRow) = "Boolean" Then
MsgBox "マクロ実行をキャンセルします"
Exit Sub
End If
'入力された数値が整数か判定(小数点があるならマクロ実行キャンセル)
If Int(headerRow) <> headerRow Then
MsgBox "入力された数値が小数点であるためマクロ実行をキャンセルします"
Exit Sub
End If
If TypeName(headerRow) = "Boolean" Then
MsgBox "マクロ実行をキャンセルします"
Exit Sub
End If
'罫線をつけるかどうかの選択肢:はい、いいえ、キャンセル
bordersFlg = MsgBox( _
PROMPT:="罫線を設定しますか?", _
TITLE:="罫線設定の有無", _
Buttons:=vbYesNoCancel)
If bordersFlg = vbCancel Then
MsgBox "マクロ実行をキャンセルします"
Exit Sub
End If
If headerRow < 1 Then headerRow = 1 '入力された見出し行数が1未満の場合のみ見出し行数を1として取り扱う
On Error Resume Next '一時的なエラー無効化(テーブルに対して下記コード実行するとエラーとなるためエラー無効化
If .AutoFilterMode = False Then
'オートフィルターが設定されていないならオートフィルターを設定
.Range("A" & headerRow).EntireRow.Select
Selection.AutoFilter
End If
On Error GoTo 0 'On Errorの無効化
If bordersFlg = vbYes Then '罫線設定するが「はい」なら下記を実行
.Range("A" & headerRow).CurrentRegion.Borders.LineStyle = xlContinuous
End If
lastColomns = .Cells(headerRow, Columns.count).End(xlToLeft).Column
.Range(Columns(1), Columns(lastColomns)).EntireColumn.AutoFit '列幅を自動調整
.Range(Columns(1), Columns(lastColomns)).ColumnWidth = Range(Columns(1), Columns(lastColomns)).ColumnWidth + 2 '列幅に余裕を持たせる
For j = lastColomns To 1 Step -1
If Application.WorksheetFunction.CountA(.Columns(j)) <= 1 Then 'ヘッダなしも含めて1未満
On Error Resume Next '一時的なエラー無効化
'何度もこのマクロ実行すると同じ列のグループ化階層が深くなるため、事前に一度グループ化解除(グループ化していない列を解除するとエラーとなるためエラー無効化)
.Columns(j).Ungroup
On Error GoTo 0 'On Errorの無効化
.Columns(j).Group 'グループ化
'Debug.Print j '一時確認用
End If
Next j
End With
ws.Outline.ShowLevels ColumnLevels:=1
Range("A" & headerRow + 1).Select
ActiveWindow.FreezePanes = True '見出し行の下でウィンドウ枠の固定
Application.ScreenUpdating = True '画面更新の開始
MsgBox "処理が終了しました。", , "処理結果通知"
End Sub
ヘッダー(見出し行)が何行目にあるかは、マクロ実行後にInputBoxで尋ねられるので、ヘッダーの行数を入力してください。(例:2)
罫線を設定するかどうかはオプションです。お好みに合わせて都度、選択してください。(こちらも、マクロ実行後にMsgBoxで尋ねられる仕様です。)
マクロ内でアクティブブックを上書き保存するといったことは行っていませんが、マクロ実行後は「戻る」ことができませんので、行われたデータ加工が意に沿わないものであったら元のデータに戻ることができるように、マクロ実行前のデータを保存しておく等の対応はご自身で適宜お願いします。
基幹システム等から出力した加工前のExcelやCSVファイルを見やすく加工するためのものなので、マクロ有効ブックではなく、個人マクロブックやアドイン内の標準モジュールにコードを保存して利用することを想定しています。
リボンにマクロを登録して使用してもよいですし、個人マクロブックのThisWorkbookに下記のように記載して、「CTRL+SHFT+D」のショートカットキーでマクロを起動できるようにすると、素早くマクロを実行できます。
(何らかのブックを開いたときに個人マクロブックが自動で開かれ、そのときにショートカットキーが登録される仕様なので、最初に下記のコードを個人マクロブックのThisWorkBookに記載したときは、一度開いているブックをすべて閉じて、ブックを開き直した後にショートカットキーが登録されます。)
Private Sub Workbook_Open() '個人マクロブック等のThisWorkBookに記載する。
'ショートカットキー設定
Application.OnKey "^+{D}", "sbデータ整形" 'CTRL+SHFT+Dで「"sbデータ整形」を起動
End Sub
標準モジュールの先頭で、Option Private Moduleと記載してPrivate Module 設定している場合は、マクロ一覧(ALT+F8)のオプションからショートカットキーを登録できない。(しかし、Option Private Moduleと記載しておくと、管理しているプロシージャが多いときにごちゃごちゃせずに便利です。)
標準モジュールの先頭で、Option Private Moduleと記載しているときでもショートカットキーを登録したいときは、OnKey等でショートカットキーを登録することができます。
また、OnKeyでの割り当ての場合には、マクロ一覧のオプションからとは違ってCtrl+又はCtrl+Shift+との組み合わせでなくとも、ショートカットキーを登録することができます。
上記のプロシージャに、金額を表示する列の場合に3桁区切り等の自動設定する機能を付加してみたことがあります。しかし、金額に加えて、日付を表示する列等もあると、これらを区別することが思いのほか難しかったです。(コード自体は書けたが、金額・日付を上手く判別できませんでした。)
そのため、3桁区切り等の書式設定まで実装するのは一旦諦めました。