見出し画像

システムから出力したデータをExcelVBAで一瞬で加工する

基幹システムや会計システム等から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+との組み合わせでなくとも、ショートカットキーを登録することができます。

もしよろしければサポートをお願いします。今後の執筆のかてにします。