小技集

以下の表のカテゴリーの項目のように同じ値が複数行に続く場合、それらの同じ値のセルを瞬時に結合する機能の開発方法について解説していきます。

こちらで開発する機能は、どんな表にも適用できるようしています。
そのため、既存の表をプレゼン用や配布用として用意する際に活用すると便利です。
※こちらで開発したファイルは、記事の最後にて配布しています。

開発準備

まず初めに、[開発]タブを選択し、[マクロ]を作成します。

表示された以下の画面にて、開発する機能の名前を入力し、[作成]を選択します。
こちらでは、「自動結合」と入力しています。

次に表示される以下の画面の「Sub ○○」から「End Sub」の間にコードを記述します。

コードの記述

以下のコードを記述します。

Sub 自動結合()

    Dim colNo As Long
    colNo = ActiveCell.Column
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, colNo).End(xlUp).Row
    
    Dim sRow As Long
    sRow = 1
    Dim i As Long
    Application.DisplayAlerts = False
    For i = 1 To lastRow
        If Cells(i, colNo).Value <> Cells(i + 1, colNo).Value Then
            Range(Cells(sRow, colNo), Cells(i, colNo)).Merge
            sRow = i + 1
        End If
    Next i
    Application.DisplayAlerts = True
    
End Sub

では、コードについて解説していきます。

    Dim colNo As Long
    colNo = ActiveCell.Column

今回の機能は、選択しているセルの列に対して、同じ値が連続するセルを結合していきます。
そのため、基準となる列番号を格納する用の「colNo」という変数を用意し、アクティブセル（ActiveCell）の情報から列番号（Column）を取得しています。

    Dim lastRow As Long
    lastRow = Cells(Rows.Count, colNo).End(xlUp).Row

先頭行から１行ずつ、同じ値が連続していないかどうかを確認していきます。
そのため、繰り返し終える位置である最終行の行番号を格納する用の「lastRow」という変数を用意し、「colNo」の列を基準に最終行の行番号を取得しています。
取得される行番号は、「colNo」の列の、シート上の一番下のセル（Cells(Rows.Count, colNo)）を選択している状態で、「Ctrl+↑」（End(xlUp)）で移動した先のセルの行番号（Row）になります。

    Dim sRow As Long
    sRow = 1

こちらに関しては、結合する際の開始の行番号を格納する用の「sRow」という変数を用意しています。
また、初期値として「1」を設定しています。

    Dim i As Long
    Application.DisplayAlerts = False
    For i = 1 To lastRow
        …
    Next i
    Application.DisplayAlerts = True

次に、先頭行から最終行までを繰り返す時に使用する「i」という変数を用意し、繰り返し処理（For）の前に、結合時の以下の警告を無視する設定（Application.DisplayAlerts = False）を行っています。

繰り返し処理（For）を終えた後には、警告を無視する設定を解除するコード（Application.DisplayAlerts = True）を記述しています。

    For i = 1 To lastRow
        If Cells(i, colNo).Value <> Cells(i + 1, colNo).Value Then
            Range(Cells(sRow, colNo), Cells(i, colNo)).Merge
            sRow = i + 1
        End If
    Next i

では最後、繰り返し処理（For）の内容です。
繰り返し処理（For）では、先頭行から最終行（lastRow）まで１行ずつ繰り返し、内側の条件分岐（If）で、「繰り返し処理の該当行（i）の該当列（colNo）の値と、その次の行（i + 1）の値が一致しない場合」という条件の確認を行っています。
一致しない場合に関しては、該当列（colNo）の開始の行（sRow）から繰り返し処理の該当行（i）までの範囲のセルを結合（Merge）しています。
結合後は、次の結合時の開始の行番号（sRow）を繰り返し処理の該当行（i）の次の行番号（i + 1）に変更しています。

上記のコードを実行することによって、選択しているセルの列に対して、同じ値が連続するセルを結合することができます。

以下のコードに関しては、単体のセル範囲では結合されません。

Range(Cells(sRow, colNo), Cells(i, colNo)).Merge

そのため、今回のようなコードの内容で実現することができます。

▼サンプルファイル▼

以下のように、数式で複数のシートに用意された表を１つのシートにまとめて表示する方法について解説していきます。

複数の表を縦方向に繋げる

複数の表を縦方向に繋げるには、VSTACK関数を活用します。
この関数の使い方は、以下になります。

=VSTACK(配列1, [配列2], [配列3], …)
// 配列：対象の表（必要な数分、カンマ区切りで指定する）

実際に、各シートの表を指定して表を繋げる場合、以下のような数式になります。

=VSTACK('2024年1月'!A2:C10,'2024年2月'!A2:C10,'2024年3月'!A2:C11,'2024年4月'!A2:C11,'2024年5月'!A2:C11)
// それぞれのシートの表を1つ1つ指定

VSTACK関数を使うことで、上記のように表を繋げることができました。
しかし、この数式のままですと、「シートの数が増えた時」や「表にデータが追加された時」に対応するのが大変になります。
そこで、複数のシートの表を一括で指定する数式に変更していきます。

複数の表を一括で指定する

複数のシートの範囲を一括で指定する場合、「=VSTACK(」と入力した後に、「対象の先頭のシート」を選択した後に、Shiftキーを押しながら、「対象の末尾のシート」を選択します。
この時、対象のシートの間に対象でないシートが含まれていると、その対象でないシート自体も参照されてしまいます。
対象の末尾のシートを選択することができましたら、アクティブになっているシートの表の範囲を大きめに指定します。
実際に上記の手順で指定すると、以下のような数式になります。

=VSTACK('2024年1月:2024年5月'!A2:C100)
// 今後データが追加されることを考慮して100行目まで指定

上記の数式を入力すると、空の範囲が「0」として抽出されてしまいます。
ただ、全シートの表を繋げることができました。

「0」を除外する方法については、後で解説していきます。

こちらで参照しているシートは、対象のシートの先頭から末尾のシートになります。
次から追加するシートに関しては、指定した先頭と末尾のシートの間に移動することで、数式を修正する必要がなく、まとめた表に加えることができるようになります。

そのため、先頭と末尾のシートに関しては「空の表」にし、シートの開始と終了が分かりやすいようなシート名にしておくと良いです。
実際に、修正した例が以下になります。

=VSTACK(S:G!A2:C100)

先頭と末尾のシートに関しては、以下のように空の表にしています。

以上の手順で、複数のシートの表を一括で指定し、抽出することができました。
ただ、空（「0」）のデータが表示されている状態では、見た目が良くないので、空（「0」）のデータを除外して抽出する数式に変更する必要があります。

空（「0」）のデータを除外する

抽出した表から、更に絞って抽出するには、FILTER関数を活用します。
この関数の使い方は、以下になります。

=FILTER(配列, 含む, [空の場合])
// 配列：抽出対象の表
// 含む：配列に指定した表から抽出する条件
// [空の場合]：条件を満たしたデータが存在しない場合に表示する値

先ほどの数式にFILTER関数を組み合わせると、以下のような数式になります。

=FILTER(VSTACK(S:G!A2:C100),VSTACK(S:G!A2:A100)<>"","")
// VSTACK(S:G!A2:C100)：抽出対象の表
// VSTACK(S:G!A2:A100)<>""：抽出条件
// → 抽出対象の範囲のA列の値（日付の項目）が空でない場合
// ""：データが存在しない場合は空を表示

上記のように、FILTER関数を組み合わせて抽出条件を加えることで、先頭列（日付の項目）が空のデータを除外して抽出することができます。
また、各シートの表へのデータの追加にも対応することができます。

以下の表に対し、「項目名（見出し）をクリックするだけで、その項目を基準に並べ替えを行う」という機能の開発方法について解説していきます。

※こちらで開発したファイルは記事の最後にて配布しています。

開発準備

「特定のセルを選択すると同時に、何かしら処理を実行する」という仕組みは、該当するシートモジュールのイベントプロシージャを活用することで実現できます。

シートモジュールは、該当するシートのタブ上で右クリックし、[コードの表示]を選択することで表示することができます。

選択すると、以下のエディタ画面（VBE）が表示されます。
また、該当するシートのシートモジュールが表示された状態になります。
「Option Explicit」は、VBEの設定内容次第では表示されません。「Option Explicit」についての解説はこちらでは省略します。

次に、セルを選択すると同時に処理が実行される特殊なプロシージャ（イベントプロシージャ）を用意する必要があります。
そのためには、シートモジュールの左上のリストから「Worksheet」を選択する必要があります。

「Worksheet」を選択すると、自動で「Worksheet_SelectionChange」というプロシージャが表示されます。
このプロシージャが、該当するシート上のいずれかのセルが選択されると同時に処理が実行されるイベントプロシージャと呼ばれるものになります。

まずは、表示された「Worksheet_SelectionChange」というプロシージャ内にコードを記述していきますが、他のイベントプロシージャを表示したい場合は、右上のリストから表示することができます。

左上のリストで「Worksheet」を選択すると、右上のリストに関しては、自動で「SelectionChange」が選択され、「Worksheet_SelectionChange」というプロシージャが表示されます。

項目名をクリックするだけで昇順にする

では、項目名をクリックするだけで、その項目を基準に表を昇順にする機能を開発していきます。

まずは、以下のコードを「Worksheet_SelectionChange」というプロシージャ内に記述します。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Row = 2 And _
        Target.Column >= 2 And Target.Column <= 5 Then
        
        Dim rng As Range
        Set rng = Range("B2").CurrentRegion
        rng.Sort _
            Key1:=Target, _
            Order1:=xlAscending, _
            Header:=xlYes
        
    End If
    
End Sub

では、コードについて解説していきます。

    If Target.Row = 2 And _
        Target.Column >= 2 And Target.Column <= 5 Then
        
        …
        
    End If

「Worksheet_SelectionChange」プロシージャの引数「Target」に、トリガーとなったセルの情報が渡されます。
そのTargetを活用し、そのTargetの情報が「行番号が2、尚且つ、列番号が2以上、5以下」であるかどうかを確認しています。
その条件を満たしている時、要するに、以下の項目名の範囲内が選択された時に、Ifの中の処理が実行されます。

        Dim rng As Range
        Set rng = Range("B2").CurrentRegion
        rng.Sort _
            Key1:=Target, _
            Order1:=xlAscending, _
            Header:=xlYes

こちらで「rng」というRange型の変数を用意し、その変数に対象の表の範囲を割り当てています。
「Range(“B2”).CurrentRegion」で、セルB2周囲に連続しているデータ範囲全体を指定しています。

その「rng」に対し「Sort」で並べ替えを行っています。
「Key1:=Target」でTargetの属する列を並べ替えの基準の列として指定し、「Order1:=xlAscending」で昇順を指定、「Header:=xlYes」でrngが項目名を含む範囲ということを指定しています。

以上の内容で実現できます。
該当する項目名を選択することで、以下のように並べ替えを行うことができます。

項目名を右クリックするだけで降順にする

では次に、項目名を右クリックすることで、その項目を基準に表を降順にする機能を開発していきます。

先ほどと同様に、シートモジュール上にコードを記述していきます。
ただ、先ほどとは別のイベントプロシージャを使用する必要があります。

そのプロシージャとは、該当するシート上のいずれかのセルの上で右クリックした時に処理が実行されるというイベントプロシージャです。
シートモジュールの右上のリストから「BeforeRightClick」を選択することで表示することができます。

表示された「Worksheet_BeforeRightClick」というプロシージャ内にコードを記述していきます。

まずは、以下のコードを記述します。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    
    If Target.Row = 2 And _
        Target.Column >= 2 And Target.Column <= 5 Then
        
        Cancel = True
        Dim rng As Range
        Set rng = Range("B2").CurrentRegion
        rng.Sort _
            Key1:=Target, _
            Order1:=xlDescending, _
            Header:=xlYes
        
    End If
    
End Sub

コードの内容は、先ほどの内容とほぼ同じになります。
そのため、異なる点のみを解説します。

        Cancel = True

「Cancel」に対し、Trueを指定することで、右クリック時にメニューが表示されないようにすることができます。

        rng.Sort _
            Key1:=Target, _
            Order1:=xlDescending, _
            Header:=xlYes

先ほどの内容とは異なり、こちらでは「Order1:=xlDescending」として降順にしています。

以上の内容で実現できます。
該当する項目名の上で右クリックすることで、以下のように並べ替えを行うことができます。

▼サンプルファイル▼

以下のような表で、空白行を除外して上に詰める場合、並べ替え機能を活用すると、書式の設定位置や要素の順番に関しても変わってしまいます。

今回は、書式の設定位置や要素の順番を変えずに、そのままの状態で上詰めする機能をVBAで開発する方法について解説していきます。
※こちらで開発したファイルは、記事に最後にて配布しています。

開発

初めに、[開発]タブの中の[マクロ]を選択します。

[マクロ]を選択すると表示される以下の画面に、開発する機能の名前を入力し、[作成]を選択します。
こちらで「上詰め」と入力しています。

[作成]を選択すると表示される以下のエディタ画面の「Sub 上詰め()」から「End Sub」の間にコードを記述していきます。
「Option Explicit」は、エディタの設定次第では表示されません。

では、以下のコードを記述します。

Sub 上詰め()

    Dim inData As Variant, outData As Variant
    inData = Range("B3:B11").Value
    ReDim outData(1 To UBound(inData), 1 To 1) 
    
    Dim d As Variant, i As Long: i = 1
    For Each d In inData
        If d <> "" Then 
            outData(i, 1) = d
            i = i + 1
        End If
    Next d
    
    Range("B3:B11").Value = outData
    
End Sub

解説

このコードについて、簡単に解説していきます。

    Dim inData As Variant, outData As Variant
    inData = Range("B3:B11").Value

ここで、inDataとoutDataという変数を用意し、inDataには上詰めする対象のセル範囲B3～B11の値のみを格納しています。
具体的には、inDataにセルB3～B11の値を１列の２次元配列として取得しています。

    ReDim outData(1 To UBound(inData), 1 To 1) 

outDataに関しては、inDataと同じ行数、列数の２次元配列になるように変換しています。
inDataのようにセルの範囲を格納すると、添字が１からの２次元配列になるため、outDataに関しても同様に、添字を１からとした２次元配列を用意しています。
行に関しては、UBoundを用いてinDataの行数を取得し、列に関しては、１列のみの範囲になるため、「1 To 1」と１列のみを用意しています。

    Dim d As Variant, i As Long: i = 1
    For Each d In inData
        If d <> "" Then 
            outData(i, 1) = d
            i = i + 1
        End If
    Next d

次に、必要な変数を用意し、For EachでinDataの値を先頭から１つずつ繰り返してdに渡しています。
この繰り返し処理の中で、dの値が空でない場合に、outDataのi行目に加えていくようにしています。
この「i」に関しては、初期値は１で、outDataに加えられた後に、「i」自身に１を加えています。
これにより、outDataには、inDataの空の値を除外した値のみが上詰めで格納されます。

    Range("B3:B11").Value = outData

最後に、outDataの値を対象の表に貼り付けています。
outDataの配列の要素で、値が格納されなかった要素に関しては、初期値として空が渡されます。

ボタン作成

後は、開発した機能をボタンに割り当てることで完成です。
ボタンに関しては、[開発]タブの中の[挿入]から作成することができます。

[挿入]から[フォームコントロール]の中の[ボタン]を選択し、図形を作成する時と同様に、好みの位置にボタンを作成します。
ボタンを作成すると、[マクロの登録]という画面が表示されるため、開発した機能の名前（上詰め）を選択して確定します。

これだけで、開発した機能を割り当てたボタンを作成することができます。
必要に応じて、ボタンの名前を変更すると良いです。
※一度作成したボタンを選択すると、機能が実行されてしまいます。作成後に編集する際は、右クリック、もしくはCtrlキーを押しながらクリックすることで編集することができます。

▼サンプルファイル▼