Excelのマクロです。

Excelの表で、行連結しているとフィルターを掛けたときに、１行分しか表示されず、不便に思ったことはないでしょうか。

他部署から相談を受けて作成したので、マクロですがご紹介します。

最初のConst ・・・の３行の値は、シートに合わせて変更してください。（今の値は上の表の場合です）

下記のマクロを、そのシートのところにVisual Basic for Applicationsでコピペしてください。

（Visual Basic for Applicationsの開き方が分からない人はご質問ください）

ほとんどの行にコメントを付けておきましたので、ご理解いただき、応用していただけると嬉しいです。

Option Explicit

Const WK_R As Integer = 1 '一時利用するセルの行　 ※シートに合わせて変更
Const WK_C As Integer = 12 '一時利用するセルの列　 ※シートに合わせて変更
Const Data_R As Integer = 11 'データ入力開始行　 ※シートに合わせて変更

Dim 作業中Flg As String 'マクロ実行中の割り込み制御用

Private Sub Worksheet_Activate()
    作業中Flg = ""
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim R As Integer
    Dim C As Integer
    Dim SVR As Integer
    Dim SVC As Integer

    If 作業中Flg <> "" Then '本マクロ実行中なので抜ける

        Exit Sub
    End If

    R = Target.Row '変更された行　取得
    C = Target.Column '変更された列　取得

    If R < 11 Then 'データは11行目からなので10行以下は抜ける
        Exit Sub
    End If

    If Cells(R, C).MergeCells = False Then '結合セルでなければ抜ける
        Exit Sub
    End If

    作業中Flg = "作業中" 'セル編集開始
    SVR = ActiveCell.Row '今、動いた後のセル位置（行）取得
    SVC = ActiveCell.Column '今、動いた後のセル位置（列）取得
    Cells(WK_R, WK_C) = Cells(R, C) '変更後の値を一時セルへコピー
    Range(Cells(WK_R, WK_C), Cells(WK_R, WK_C)).Select '一時セルを範囲指定し
    Selection.Copy 'コピーを実行
    Range(Cells(R, C), Cells(R, C)).Select '結合セルを範囲指定し
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False '式の貼り付け
    Range(Cells(SVR, SVC), Cells(SVR, SVC)).Select '動いた後のセルへカーソル移動
    Application.CutCopyMode = False 'コピーモード解除
    作業中Flg = "" 'マクロ実行中解除
End Sub