【ExcelVBA】列幅を自動調整して枠線付の綺麗な表を簡単作成

快速ワーク
2019.04.20
スポンサーリンク

インターネットやデータベースなどからデータを抽出してExcelに貼り付けてデータを整理したい場面はあるかと思います。

そんな操作を仕事や勉強で頻繁に行う必要がある人も結構多いと思います。

そんな時、いちいち列幅を調整して枠線を付ける段階的な作業ってめんどくさいですよね。

その一連の操作を一発で行い、列幅を自動調整して枠線を付加し、綺麗な表を簡単に作成するマクロを作成してみました。

百聞は一見に如かず、一目瞭然、一発でイメージが湧き、使い方がわかるようなGIFアニメ付きです。

ぜひ、コピーしてご活用ください。

スポンサーリンク

列幅の調整と表の枠線付加って結構めんどくさい

私は仕事でデータベースから抽出してかなり頻繁にExcelにデータを貼り付けるので、結構めんどくさいんですよね。

ショートカットキーを駆使しても限界があります。「テーブルの作成」機能(Ctrl+T)も使い方次第では有効ですが、融通が利かない場面が多いです。

一発で綺麗に整形された表を作りたい

同じように感じている人はいるのではないでしょうか。

そんな人向けに簡単なマクロを作ってみました。

Excelの列幅と罫線VBAマクロの操作イメージ

マクロを登録して、下記の画像操作と同じようにやってみてください。

マクロを使うとCtrl+Zでは元に戻らないのでご注意ください。マクロを使う場合はブックを保存した状態で実行する癖を付けることをオススメします。

Excelの列幅と罫線VBAマクロの主な仕様

細かい処理はコメントで補足してるので、ザックリとした仕様を箇条書きで記載します。

  • 開始セルからデータの内容を基に終了位置を割り出し、処理対象のセル範囲を確定
  • 対象データがあるかをチェック(なければ処理終了)
  • 2行目以降の表データに対し、列幅を自動調整(1行目タイトル部や表名などは除外)
  • 表全体に枠線を付加し、タイトル部のみ別調整(折り返し、背景色、など)



Excelの列幅と罫線VBAマクロのソースコード

表作成効率を爆上げしたい方は、下記のソースコードを以下↓↓↓のリンクの内容に従って個人用マクロにコピーしてご使用ください。

【Excel】超便利な個人用マクロブックにVBAを記録追加作成して実行【初心者も簡単】
仕事や勉強を行う上で、Excelを使用するならば、絶対に知っておいた方がよい「個人用マクロブックの設定方法」をまとめました。マクロを頻繁に使用する人、今まで「作業中のブック」のみに個別設定していた人は、自分の作業に合った共通処理の...
caymezon.com
2019.03.10

目的に合っていない場合は適当にカスタマイズしてみてください。VBAマクロの勉強にも少しは役立つと思います。

Sub 列幅自動調整して表枠線付加()

  Const 確認メッセージフラグ = 0 '0:確認メッセージを表示しない、1:確認メッセージを表示する
  
  Const 列幅調整フラグ = 1       '0:列幅調整しない、1:列幅調整する
  Const 枠線付加フラグ = 1       '0:枠線付加しない、1:枠線付加する
  Const 終了位置判定区分 = 1     '1:開始位置から行・列データ全て、2:開始位置から連続値最終位置まで
  Call 列幅自動調整_表枠線付加処理(確認メッセージフラグ, _
                                  列幅調整フラグ, _
                                  枠線付加フラグ, _
                                  終了位置判定区分)
                                  
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub 列幅自動調整_表枠線付加処理(確認メッセージフラグ As Integer, _
                              列幅調整フラグ As Integer, _
                              枠線付加フラグ As Integer, _
                              終了位置判定区分)
                              
  ''''''''''概要''''''''''
  '表の列幅を自動調整して枠線を付加する
  
  ''''''''''前提''''''''''
  '1行目タイトル、2行目以降がデータの表を対象する
  '複数行・複数列の表を対象とする（1行のみ、または1列のみの場合はチェック処理で強制終了）
  '　※終了位置によってMAXまで処理してしまうのを回避するため
  
  ''''''''''定義''''''''''
  Dim 実行確認 As Integer
  Dim メッセージ As String
  
  Dim 開始行 As Long
  Dim 開始列 As Long
  Dim 終了行 As Long
  Dim 終了列 As Long
  
  ''''''''''高速化''''''''''
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  
  ''''''''''確認処理''''''''''
  If 確認メッセージフラグ = 1 Then
    
    If 列幅調整フラグ = 1 Then
      メッセージ = メッセージ _
        & "・選択範囲セル2行目以降データで列幅を自動調整します。" & vbCrLf
    End If
    
    If 枠線付加フラグ = 1 Then
      メッセージ = メッセージ _
        & "・表データに枠線を付加し、タイトル行に色付けします。" & vbCrLf
    End If
    
    If 終了位置判定区分 = 1 Then
      メッセージ = メッセージ _
        & "・開始位置から行・列データ全てを対象とします。" & vbCrLf
    ElseIf 終了位置判定区分 = 2 Then
      メッセージ = メッセージ _
        & "・開始位置から連続で値が存在する最後のセルまでを対象とします。" & vbCrLf
    End If
    
    '実行確認
    If メッセージ <> "" Then
      実行確認 = MsgBox(メッセージ & vbCrLf _
            & "実行してよろしいですか？", vbYesNo + vbQuestion)
      If 実行確認 = vbNo Then Exit Sub
    End If
    
  End If
  ''''''''''開始位置''''''''''
  開始行 = ActiveCell.Row
  開始列 = ActiveCell.Column
  
  ''''''''''終了位置''''''''''
  If 終了位置判定区分 = 1 Then
  '開始位置から行・列データ全てを対象とする場合
  '（歯抜けデータありでも最後の値を最終としたい場合）
  
    'シート最終行から上に値を探索して値が見つかった行をデータ最終行とする(Ctrl+↑)
    終了行 = cells(Rows.Count, 開始列).End(xlUp).Row
    'シート最終列から左に値を探索して値が見つかった行をデータ最終列とする(Ctrl+←)
    終了列 = cells(開始行, Columns.Count).End(xlToLeft).Column
    
  ElseIf 終了位置判定区分 = 2 Then
  '開始位置から連続で値が存在する最後のセルまでを対象とする場合
  '（歯抜けデータなし前提の場合）
  
    '開始行から下に空データを探索して値が見つかった行をデータ最終行とする(Ctrl+↓)
    終了行 = cells(開始行, 開始列).End(xlDown).Row
    '開始列から右に空データを探索して値が見つかった列をデータ最終列とする(Ctrl+→)
    終了列 = cells(開始行, 開始列).End(xlToRight).Column
    
  End If
  
  ''''''''''チェック''''''''''
  '行データがない（終了行がMAX1048576行）、または
  '列データがない（最終列がMAX16384列）場合は強制終了
  If 開始行 >= 終了行 Or 終了行 = Rows.Count Then
  
    MsgBox "行データがありません。"
    Exit Sub
    
  ElseIf 開始列 >= 終了列 Or 終了列 = Columns.Count Then
  
    MsgBox "列データがありません。"
    Exit Sub
    
  End If
  
  ''''''''''列幅自動調整''''''''''
  If 列幅調整フラグ = 1 Then
  
    'タイトル部以外のデータ部のみ
    Range(cells(開始行 + 1, 開始列), cells(終了行, 終了列)).Columns.AutoFit
    
  End If
  
  '''''''''''表枠線付加''''''''''
  If 枠線付加フラグ = 1 Then
  
    Range(cells(開始行, 開始列), cells(終了行, 終了列)).Select
    
    '全体の枠線付加
    '左側
    Selection.Borders(xlEdgeLeft).Weight = xlThin             '細
    '上段
    Selection.Borders(xlEdgeTop).Weight = xlThin              '細
    '下段
    Selection.Borders(xlEdgeBottom).Weight = xlThin           '細
    '右側
    Selection.Borders(xlEdgeRight).Weight = xlThin            '細
    '内側の縦線
    Selection.Borders(xlInsideVertical).Weight = xlThin       '細
    '内側の横線
    Selection.Borders(xlInsideHorizontal).Weight = xlHairline '極細
    
    ''''''''''タイトル部''''''''''
    Range(cells(開始行, 開始列), cells(開始行, 終了列)).Select
    
    '折り返して全体を表示する
    Selection.WrapText = True
    
    'タイトル部の背景色付加
    Selection.Interior.ColorIndex = 35
    '34:薄い水色,35:薄い緑,36:薄い黄,37:ペールブルー,38:ローズ,39:ペールブルー,40:ベージュ
    
    'タイトル部の枠線再付加(下段のみ)
    '下段
    Selection.Borders(xlEdgeBottom).Weight = xlThin           '細
    
  End If
  
  cells(開始行, 開始列).Select
  
finally:

  '''''''''''高速化''''''''''
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  
End Sub
変更履歴

2019/6/8
・メイン処理を呼び出す形に変更（パラメータを渡して共通処理を呼び出す）

ちょっとカスタマイズしてみる

お好みで以下コードを追加してみてください。

うっとおしいシート枠線を非表示にする

シート上の枠線、うっとおしいと感じる時はありませんか？ そんな時は「''''''''''列幅自動調整''''''''''」の前に以下コードを追加してみましょう。

    'シート枠線の非表示
    ActiveWindow.DisplayGridlines = False

自分好みのフォントに変えてみる

上記画像のフォントは「ＭＳ Ｐゴシック」ですが、自分の好きなフォントに変えたい場合は「''''''''''列幅自動調整''''''''''」の前に以下コードを追加してみましょう。（例：メイリオ）

    'フォント変更
    cells.Font.Name = "メイリオ"

フォントによって行の高さや列の幅が変わるので列幅調整の前に入れる必要がある。

タイトル背景色をちょっとオシャレにする

ちょっとオシャレに背景色にグラデーションなんか付けてみたくなった時は、手動でやるとそれこそ本当にめんどくさいので、マクロ化をすべきでしょう。

「'タイトル部の背景色付加」の部分を以下のコードに置き換えてみてください。

        '濃い青系のグラデーション化
        'フォント色
        Selection.Font.Color = RGB(255, 255, 255)                 '白
        '背景色
        With Selection.Interior
            .Pattern = xlPatternLinearGradient
            .Gradient.Degree = 90
            .Gradient.ColorStops.Clear
        End With
        With Selection.Interior.Gradient.ColorStops.Add(0)
            .Color = RGB(130, 160, 190)
        End With
        With Selection.Interior.Gradient.ColorStops.Add(1)
            .Color = RGB(31, 78, 120)
        End With

タイトル部にフィルタを付けてデータ解析しやすくする

表データを解析するために便利なフィルタを付けたい場合は「'''''''''''表枠線付加''''''''''」のIf文の最後に以下コードを追加してみましょう。

        '行フィルタ
        Selection.AutoFilter

タイトル部でウィンドウ枠を固定化してデータ解析しやすくする

大量データを解析する時に常にデータの内容を把握するため、タイトル部でウィンドウ枠固定化をしたい場合は「'''''''''''表枠線付加''''''''''」のIf文の最後に以下コードを追加してみましょう。

        'ウィンドウ枠を固定
        Rows(開始行 + 1).Select
        ActiveWindow.FreezePanes = True

カスタマイズ後のソースコード

コチラの方がよろしければコチラをご活用ください。物足りない場合はさらに自分に合ったカスタマイズをしてみてください。

Sub 列幅自動調整_表枠線付加()
    
    ''''''''''概要''''''''''
    '表の列幅を自動調整して枠線を付加する
    
    ''''''''''前提''''''''''
    '1行目タイトル、2行目以降がデータの表を対象する
    '複数行・複数列の表を対象とする（1行のみ、または1列のみの場合はチェック処理で強制終了）
    '　※終了位置によってMAXまで処理してしまうのを回避するため
    
    ''''''''''定義''''''''''
    Const 列幅調整フラグ = 1   '0:列幅調整しない、1:列幅調整する
    Const 枠線付加フラグ = 1   '0:枠線付加しない、1:枠線付加する
    Const 終了位置判定区分 = 1 '1:開始位置から行・列データ全て、2:開始位置から連続値最終位置まで
    
    Dim 開始行 As Long
    Dim 開始列 As Long
    Dim 終了行 As Long
    Dim 終了列 As Long
    
    ''''''''''高速化''''''''''
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ''''''''''開始位置''''''''''
    開始行 = ActiveCell.Row
    開始列 = ActiveCell.Column
    
    ''''''''''終了位置''''''''''
    If 終了位置判定区分 = 1 Then
    '開始位置から行・列データ全てを対象とする場合
    '（歯抜けデータありでも最後の値を最終としたい場合）
        
        'シート最終行から上に値を探索して値が見つかった行をデータ最終行とする(Ctrl+↑)
        終了行 = cells(Rows.Count, 開始列).End(xlUp).Row
        'シート最終列から左に値を探索して値が見つかった行をデータ最終列とする(Ctrl+←)
        終了列 = cells(開始行, Columns.Count).End(xlToLeft).Column
        
    ElseIf 終了位置判定区分 = 2 Then
    '開始位置から連続で値が存在する最後のセルまでを対象とする場合
    '（歯抜けデータなし前提の場合）
    
        '開始行から下に空データを探索して値が見つかった行をデータ最終行とする(Ctrl+↓)
        終了行 = cells(開始行, 開始列).End(xlDown).Row
        '開始列から右に空データを探索して値が見つかった列をデータ最終列とする(Ctrl+→)
        終了列 = cells(開始行, 開始列).End(xlToRight).Column
        
    End If
    
    ''''''''''チェック''''''''''
    '行データがない（終了行がMAX1048576行）、または
    '列データがない（最終列がMAX16384列）場合は強制終了
    If 開始行 >= 終了行 Or 終了行 = Rows.Count Then
        
        MsgBox "行データがありません。"
        Exit Sub
    
    ElseIf 開始列 >= 終了列 Or 終了列 = Columns.Count Then
        
        MsgBox "列データがありません。"
        Exit Sub
    
    End If
    
    'シート枠線の非表示
    ActiveWindow.DisplayGridlines = False
    
    'フォント
    cells.Font.Name = "メイリオ"
    
    ''''''''''列幅自動調整''''''''''
    If 列幅調整フラグ = 1 Then
        
        'タイトル部以外のデータ部のみ
        Range(cells(開始行 + 1, 開始列), cells(終了行, 終了列)).Columns.AutoFit
    
    End If
    
    '''''''''''表枠線付加''''''''''
    If 枠線付加フラグ = 1 Then
        
        Range(cells(開始行, 開始列), cells(終了行, 終了列)).Select
        
        '全体の枠線付加
        '左側
        Selection.Borders(xlEdgeLeft).Weight = xlThin             '細
        '上段
        Selection.Borders(xlEdgeTop).Weight = xlThin              '細
        '下段
        Selection.Borders(xlEdgeBottom).Weight = xlThin           '細
        '右側
        Selection.Borders(xlEdgeRight).Weight = xlThin            '細
        '内側の縦線
        Selection.Borders(xlInsideVertical).Weight = xlThin       '細
        '内側の横線
        Selection.Borders(xlInsideHorizontal).Weight = xlHairline '極細
        
        ''''''''''タイトル部''''''''''
        Range(cells(開始行, 開始列), cells(開始行, 終了列)).Select
        
        '折り返して全体を表示する
        Selection.WrapText = True
        
        '濃い青系のグラデーション化
        'フォント色
        Selection.Font.Color = RGB(255, 255, 255)                 '白
        '背景色
        With Selection.Interior
            .Pattern = xlPatternLinearGradient
            .Gradient.Degree = 90
            .Gradient.ColorStops.Clear
        End With
        With Selection.Interior.Gradient.ColorStops.Add(0)
            .Color = RGB(130, 160, 190)
        End With
        With Selection.Interior.Gradient.ColorStops.Add(1)
            .Color = RGB(31, 78, 120)
        End With
        
        'タイトル部の枠線再付加(下段のみ)
        '下段
        Selection.Borders(xlEdgeBottom).Weight = xlThin           '細
        
        '行フィルタ
        Selection.AutoFilter
    
        'ウィンドウ枠を固定
        Rows(開始行 + 1).Select
        ActiveWindow.FreezePanes = True
        
    End If
    
    cells(開始行, 開始列).Select
    
finally:
    
    '''''''''''高速化''''''''''
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

End Sub

列幅と罫線マクロのGASとExcelVBAとの違い

GAS版はコチラ。

【GAS】スプレッドシートで列幅調整と罫線付の綺麗な表を簡単作成【操作画像付】
インターネットやデータベースなどからデータを抽出して表に貼り付けてデータを整理したい場面はあるかと思います。そんな操作を仕事や勉強で頻繁に行う必要がある人も結構多いはず。そんな時、いちいち列幅を調整して枠線を付ける段階的な...
caymezon.com
2019.06.08

仕様、ロジックはほとんど同じです。

ExcelからGoogleスプレッドシートに徐々にでも移行を考えている方は見比べて参考にしてみてください。

最後に

Excelの使い方は人それぞれ、いろんなやり方があると思いますが、一例としてご紹介させていただきました。

ExcelVBAマクロはちょっとした向上心さえあれば、取っ付きやすいプログラムなのでショートカットキーなどと組み合わせてぜひ活用してみてください。

Excel全ショートカットキー一覧はこちら↓↓↓

Excelの使い方や機能がわかるショートカットキー全まとめ一覧【初心者こそ必見】
表計算ソフトとして王者であるExcel。たくさんの人が使っていると思います。まぁまぁ高額ではありますが、その分、高機能なので使い倒したいとは思いませんか？単に表データを扱うだけではなく、図を挿入できたり、設計書などのドキュ...
caymezon.com
2019.04.01

ちょっと工夫すれば、ちょっとした操作に１分かかっていた作業を１０秒でこなすことができるようになる可能性があります。

それだけでも、積み上げれば相当の工数を削減できるはずなので、ぜひ自分に合ったやり方を模索していきましょう。

スポンサーリンク

コメント

//▼2023/04/08追加 //https://lovagelab.com/posts/3406/ //▲2023/04/08追加