作者別: it-yobi

セルに値を入力すると同時に、値を自動で上に詰める仕組みの実現方法について紹介していきます。

また、今回の仕組みでは、表の途中の値を削除した際にも、値が自動で上に詰められます。

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

1. 開発準備

こちらでは、以下のような「氏名」を入力する１列の表を活用します。

そして、「この表に新規で値を入力した時や、値を削除した時に、表の値を上に詰める」という仕組みを実装していきます。

そのように、該当するシートのセルを編集すると同時に処理を自動で実行するには、「シートモジュール」の「イベントプロシージャ」を活用します。
シートモジュールは、該当するシートのタブ上で右クリックし、[コードの表示]を選択することで表示することができます。

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

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

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

ただ、今回使用するイベントプロシージャは、セルを編集すると同時に処理が実行されるものになります。
そのため、右上のリストから「Change」を選択します。

表示された「Worksheet_Change」というプロシージャを活用します。
「Worksheet_SelectionChange」というプロシージャに関しては削除して問題ないです。

2. コードの記述

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

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.CountLarge = 1 And _
        Target.Row >= 3 And _
        Target.Column = 2 Then
        
        Application.EnableEvents = False
        
        Dim lRow As Long
        lRow = Cells(Rows.Count, "B").End(xlUp).Row
        
        On Error Resume Next
        Range("B3", Cells(lRow, "B")). _
            SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        On Error GoTo 0
        
        Application.EnableEvents = True
        
    End If
    
End Sub

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

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.CountLarge = 1 And _
        Target.Row >= 3 And _
        Target.Column = 2 Then
        
        '省略
        
    End If
    
End Sub

「Worksheet_Change」というプロシージャの引数の「Target」に、編集されたセルの情報が渡されるため、そのセルの情報から、表の対象のセルが編集されたかどうかを確認しています。
こちらでは、編集されたセルが１つ（Target.CountLarge = 1）で、行番号が３以上（Target.Row >= 3）、尚且つ、列番号が２（Target.Column = 2）であることを確認しています。
この条件は「表の範囲内の単体のセルが編集された時」という条件になります。

この条件を満たした場合に、Ifの中の処理を実行します。

        Application.EnableEvents = False
        
        '省略
        
        Application.EnableEvents = True

今回の処理の内容は、セルの値を上に詰めるという内容です。
Ifの条件範囲内のセルを処理の中で操作するため、「Worksheet_Change」の処理が再度実行されないようイベントを無効にする処理（Application.EnableEvents = False）を記述しています。
処理の最後には、イベントの無効化を解除する処理（Application.EnableEvents = True）を記述しています。

        Dim lRow As Long
        lRow = Cells(Rows.Count, "B").End(xlUp).Row
        
        On Error Resume Next
        Range("B3", Cells(lRow, "B")). _
            SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        On Error GoTo 0

表を上に詰める方法として、こちらでは表の中の空白セルを削除して上方向にシフトするという方法で実装しています。
まずは、表の値が入力されている末尾のセルの行番号を変数「lRow」に格納しています。
B列の最終行のセル（Cells(Rows.Count, “B”)）からCtrlキーとカーソルキーの上を押して移動（End(xlUp)）した先のセルの行番号（Row）を末尾の行番号として取得しています。

次に、表の先頭のセルB3から末尾のセル（Cells(lRow, “B”)）の範囲内の空白セル（SpecialCells(xlCellTypeBlanks)）を削除（Delete）して上方向にシフト（Shift:=xlUp）しています。

ただ、この処理の内容ですと、空白セルが存在しない時にエラーになってしまうので、エラー対策をしています。
具体的には、エラーになった場合は対象の処理をスキップする（On Error Resume Next ～ On Error GoTo 0）という内容を記述しています。

3. 完成

以上の内容で実現できます。
表の中のセルを編集すると同時に、表の中の空白セルが削除され、値が上に詰められます。

▼サンプルファイル▼

以下の表は、黄色のセルにVLOOKUP関数を用いた数式が入力されており、IDをB列に入力すると同時に、該当する商品名と単価がC列とD列に抽出されるようになっています。

しかし、数式で値を抽出している場合、例外的に商品名や単価を修正する必要がある時に、修正することができません。
直接修正してしまうと数式が上書きされ、更新されなくなってしまいます。

今回は、そのような例外的な修正も可能とした「直接編集も自動抽出もできる仕組み」の実現方法について解説していきます。
※こちらで実現したファイルは記事の最後にて配布しています。

1. 開発準備

「直接編集も自動抽出もできる仕組み」を実現するためには、VBAで開発する必要があります。
今回の場合は、B列のIDのセルが編集された時に、自動でC列とD列の商品名と価格を表示させる必要があります。

このように、特定のシート内の特定のセルが編集された時に処理を実行する仕組みを実現するには、「シートモジュール」を使用します。

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

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

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

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

ただ、今回使用するイベントプロシージャは、セルに値を入力すると同時に処理が実行されるものになります。
そのため、右上のリストから「Change」を選択します。

表示された「Worksheet_Change」というプロシージャを活用します。
「Worksheet_SelectionChange」というプロシージャに関しては削除して問題ないです。

2. コードの記述

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

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Worksheets("商品管理")
    Set ws2 = Worksheets("請求書")
    
    If Target.CountLarge = 1 And _
        Target.Row >= 5 And Target.Row <= 10 And _
        Target.Column = 2 Then
        
        ws2.Cells(Target.Row, "C").ClearContents
        ws2.Cells(Target.Row, "D").ClearContents
        
        Dim lRow As Long
        lRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
        Dim i As Long
        For i = 2 To lRow
            If ws1.Cells(i, "A").Value = Target.Value Then
                ws2.Cells(Target.Row, "C").Value = _
                    ws1.Cells(i, "B").Value
                ws2.Cells(Target.Row, "D").Value = _
                    ws1.Cells(i, "C").Value
                Exit For
            End If
        Next i
        
    End If
    
End Sub

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

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Worksheets("商品管理")
    Set ws2 = Worksheets("請求書")
    
    If Target.CountLarge = 1 And _
        Target.Row >= 5 And Target.Row <= 10 And _
        Target.Column = 2 Then
        
        '省略
        
    End If
    
End Sub

「Worksheet_Change」というプロシージャの引数の「Target」に、編集されたセルの情報が渡されるため、そのセルの情報から、表の対象のセルが編集されたのかどうかを確認しています。
まずはシート情報を格納する用の変数「ws1」と「ws2」を用意し、それぞれに「商品管理」と「請求書」のシート情報を格納しています。

次に、編集されたセルの情報である「Target」から、編集されたセルが１つであり、行番号が５以上１０以下、列番号が２であることを確認しています。
これは以下の、IDの項目の範囲内のいずれかのセルが編集されたかどうかの判定になります。

IDの項目の範囲内のいずれかのセルが編集された場合に、Ifの中の処理を実行します。

        ws2.Cells(Target.Row, "C").ClearContents
        ws2.Cells(Target.Row, "D").ClearContents

先ほどの条件を満たしたときに、編集されたセルと同じ行のC列とD列、要するに同じ行の商品名と単価のセルを空にしています。

        Dim lRow As Long
        lRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
        Dim i As Long
        For i = 2 To lRow
            
            '省略
            
        Next i

次に、入力された値（ID）と一致する商品名と単価の情報を「商品管理」シートから抽出します。
「商品管理」シート内の表に関しては、今後データが追加される可能性があります。
そのため、まずは表の最終行の位置情報（行番号）を格納する用の変数「lRow」を用意し、その変数「lRow」に該当する行番号を格納しています。

最終行の行番号は、こちらではA列を基準に、A列の一番下のセルを選択して、Ctrlキーを押しながらカーソルキーの上を押して移動した先のセルの行番号から取得しています。

次に、表の先頭から順番に同じIDの行を探すために、繰り返す際の行番号を格納する用の変数「i」を用意しています。
そして、その変数「i」を活用して、２行目から先ほど取得した最終行（lRow）までを１行ずつFor文で繰り返しています。

            If ws1.Cells(i, "A").Value = Target.Value Then
                ws2.Cells(Target.Row, "C").Value = _
                    ws1.Cells(i, "B").Value
                ws2.Cells(Target.Row, "D").Value = _
                    ws1.Cells(i, "C").Value
                Exit For
            End If

最後に、繰り返しの中で、入力したID（Target.Value）と一致するID（i行目のA列の値）が存在するかどうかを確認しています。
そして、一致するIDが存在している場合に、「請求書」シートの対象行のC列とD列に、該当する商品名と単価を入力しています。

一致するIDが存在している場合は、その時点で他の商品を確認する必要がなくなるため、Exti ForでForの繰り返しを終えています。

3. 完成

以上の内容で実現できます。

IDの入力と同時に、該当するIDの商品が存在している場合は、その商品の商品名と単価が表示され、存在していない場合は、何も表示されません。
また、商品名や単価を例外的に編集した場合に関しても、対象のIDのセルを編集して確定するだけで、商品名と単価をリセットすることができます。

▼サンプルファイル▼

グループなどを管理している表で、隣のグループの表に氏名を移動したいことってありませんか？

今回は、そんな時に便利な右クリックするだけで氏名を移動できる仕組みを実現していきます。
左側の表から右側の表へ、右側の表から左側の表へ移動することができる仕組みになります。

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

1. 開発準備

今回は、表の中のセルを右クリックすることで、隣の表にデータを移動するという仕組みを実現してきます。
特定のシートの特定のセルを右クリックすることで何かしら処理を実行するには、該当するシートのシートモジュールを活用します。

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

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

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

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

ただ、今回使用するイベントプロシージャは、セル上で右クリックされると同時に処理が実行されるものになります。
そのため、右上のリストから「BeforeRightClick」を選択します。

表示された「Worksheet_BeforeRightClick」というプロシージャを活用します。
「Worksheet_SelectionChange」というプロシージャに関しては削除して問題ないです。

2. コードの記述

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

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    
    If Target.CountLarge = 1 And _
        Target.Row >= 3 Then
        
        Dim lRow As Long
        If Target.Column = 2 Then
            Cancel = True
            lRow = Cells(Rows.Count, "C").End(xlUp).Row
            Cells(lRow + 1, "C").Value = Target.Value
            Target.Delete xlUp
        ElseIf Target.Column = 3 Then
            Cancel = True
            lRow = Cells(Rows.Count, "B").End(xlUp).Row
            Cells(lRow + 1, "B").Value = Target.Value
            Target.Delete xlUp
        End If
        
    End If
    
End Sub

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

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    
    If Target.CountLarge = 1 And _
        Target.Row >= 3 Then
        
        '省略
        
    End If
    
End Sub

「Worksheet_BeforeRightClick」というプロシージャの引数の「Target」に、右クリックされたセルの情報が渡されるため、そのセルの情報から、表の対象の範囲内が右クリックされたかどうかを確認しています。
こちらでは、「右クリックされたセルが単体（複数範囲を選択した上での右クリックでない）で３行目以上のセル」と、まずは対象の表のデータ行が右クリックされたかどうかを確認しています。

この条件を満たした場合に関してのみ、Ifの中の処理を実行します。

        Dim lRow As Long
        If Target.Column = 2 Then
            '省略
        ElseIf Target.Column = 3 Then
            '省略
        End If

lRowという変数は、移動先の表の最終行の行番号を格納する用の変数になります。
こちらは後で使用します。

その次のIfで、右クリックされたセルが２列目（B列）なのか３列目（C列）なのかによって、処理を分岐しています。

            Cancel = True
            lRow = Cells(Rows.Count, "C").End(xlUp).Row
            Cells(lRow + 1, "C").Value = Target.Value
            Target.Delete xlUp

右クリックされたセルが２列目（B列）の場合は、「Cancel = True」で右クリック時のメニューが表示されないようにし、lRowに移動先の表（C列）の最終行の行番号を格納しています。
行番号は、C列の一番下のセルからCtrlキーとカーソルキーの上を押して止まった位置のセルの行番号を最終行の行番号として取得しています。
その次に、その取得した行番号の１つ下のセルに、右クリックされたセルの値を格納し、右クリックされたセルを削除して上に詰めています。

            Cancel = True
            lRow = Cells(Rows.Count, "B").End(xlUp).Row
            Cells(lRow + 1, "B").Value = Target.Value
            Target.Delete xlUp

右クリックされたセルが３列目（C列）の場合は、先ほどのB列とC列を入れ替えた処理を行っています。

3. 完成

以上の内容で実現できます。
移動したい氏名が入力されているセルの上で、右クリックすることで、その氏名を隣の表に移動することができます。

▼サンプルファイル▼