【便利エクセル】隣のセルに自動入力するマクロの作り方をご紹介

A1セルにテキストを入力したらB1セルにテキストが自動入力される

こんなマクロを設定したい！

こんな要望にお応えします。

エクセルVBAを使えば、簡単に隣のセルにテキストを自動入力することが可能です。

正解の人

難しい関数を設定する必要はありません！

「隣のセルに自動入力するマクロ」を設定すると以下のようなメリットを得ることができます。

テキスト入力作業のスピードアップ
入力ミスを減らせる
別のマクロと組み合わせ可能

この記事で紹介している「隣のセルに自動入力するマクロの作り方」を参考にすると、VBA未経験の方でも簡単にマクロを設定することができるはずです。

手入力作業の効率をアップさせたい！と考えている方は是非参考にしてみてください。

1 隣のセルに自動入力するマクロとは
2 【サンプル事例】別シート情報を取得し隣のセルに自動入力するマクロ
- 2.1 「隣のセルに自動入力するマクロ」の導入方法
3 VBA未経験者が業務効率化マクロを導入する方法
- 3.1 効率化マクロの開発依頼をする
- 3.2 効率化マクロが設定されたエクセルファイルをダウンロードする

隣のセルに自動入力するマクロとは

隣のセルに自動入力するマクロとは、

A列のセルにテキストを入力した場合、B列のセルに対応するテキストが自動で入力される

プログラムです。

例えば、

A1セルにテキストを入力したときB1セルに「テスト」というテキストが入力される

という処理を行うことができます。

設定するVBAのコードがこちら

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range(Cells(1, 1), Cells(1, 1))) Is Nothing Then
Exit Sub
Else
Cells(1, 2) = "テスト"
End If
End Sub

たった7行のコードで「隣のセルに自動入力するマクロ」を設定することができます。

氏名を入力すると連絡先が自動入力される
会社名を入力すると住所が自動入力される
苗字を入力すると名前が自動入力される

こんなエクセル業務の効率をアップさせることが可能です。

実用性の高いサンプル事例をもとに隣のセルに自動入力するマクロの処理について詳しく解説していきます。

【サンプル事例】別シート情報を取得し隣のセルに自動入力するマクロ

サンプル事例では、

D列に会社名、E列に氏名を入力。別シートの一覧表にある個人情報と一致した場合、隣のセルに自動入力するマクロ

を作成しました。

マクロの処理はこんな感じ

「会社名」と「氏名」を入力するだけで、「プルダウン一覧」シートの情報を自動入力してくれます。

さらに、「会社名」と「氏名」の入力方法は手入力ではなくプルダウンリストから選択して入力できるようマクロが設定されています。

なので、「プルダウン一覧」に記載されている情報が増減すると自動的に入力リスト項目も増減するという仕組みになっています。

エクセルVBAを使ってプルダウンリストを設定する方法については下記の記事を参考にしてみてください。

「隣のセルに自動入力するマクロ」の導入方法

「隣のセルに自動入力するマクロ」の導入方法を図を使って詳しく解説していきます。

1.様式設定

上図のように一覧表を設定してください。

「プルダウン一覧」シートに記入する一覧表
「データシート」シートに記入する一覧表

「データシート」シートの6列～8列が自動入力範囲となります。

2.VBA画面の編集

3.「データシート」にコードを入力

4-1.隣のセルに自動入力するマクロのサンプルコード

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Ash  As Worksheet
    Set Ash = Sheets("プルダウン一覧")
    Dim Bsh  As Worksheet
    Set Bsh = Sheets("データシート")
    gyo1 = Ash.Cells(Rows.Count, 2).End(xlUp).Row
    gyo2 = Ash.Cells(Rows.Count, 3).End(xlUp).Row
    gyo3 = Ash.Cells(Rows.Count, 4).End(xlUp).Row
    gyo31 = Ash.Cells(Rows.Count, 5).End(xlUp).Row
    gyo32 = Ash.Cells(Rows.Count, 6).End(xlUp).Row
    gyo4 = Bsh.Cells(Rows.Count, 4).End(xlUp).Row + 10
    gyo5 = Bsh.Cells(Rows.Count, 5).End(xlUp).Row + 10
    gyo6 = Bsh.Cells(Rows.Count, 6).End(xlUp).Row + 10
    gyo7 = Bsh.Cells(Rows.Count, 7).End(xlUp).Row + 10
    gyo8 = Bsh.Cells(Rows.Count, 8).End(xlUp).Row + 10
        If Intersect(Target, Range(Cells(3, 5), Cells(gyo5, 5))) Is Nothing Then
        GoTo L1
        Else
        For i = 3 To gyo2
        If (Bsh.Cells(Target.Row, Target.Column) = Ash.Cells(i, 3)) And (Bsh.Cells(Target.Row, Target.Column - 1) = Ash.Cells(i, 2)) Then
        Bsh.Cells(Target.Row, Target.Column + 1) = Ash.Cells(i, 4)
        Bsh.Cells(Target.Row, Target.Column + 2) = Ash.Cells(i, 5)
        Bsh.Cells(Target.Row, Target.Column + 3) = Ash.Cells(i, 6)
        GoTo L1
        Else
        Bsh.Cells(Target.Row, Target.Column + 1).ClearContents
        Bsh.Cells(Target.Row, Target.Column + 2).ClearContents
        Bsh.Cells(Target.Row, Target.Column + 3).ClearContents
        End If
        Next
        End If
L1:
        If Intersect(Target, Range(Cells(3, 4), Cells(gyo5, 4))) Is Nothing Then
        Exit Sub
        Else
        For i = 3 To gyo2
    If (Bsh.Cells(Target.Row, Target.Column) = Ash.Cells(i, 2)) And (Bsh.Cells(Target.Row, Target.Column + 1) = Ash.Cells(i, 3)) Then
    Bsh.Cells(Target.Row, Target.Column + 2) = Ash.Cells(i, 4)
    Bsh.Cells(Target.Row, Target.Column + 3) = Ash.Cells(i, 5)
    Bsh.Cells(Target.Row, Target.Column + 4) = Ash.Cells(i, 6)
    GoTo L2
    Else
    Bsh.Cells(Target.Row, Target.Column + 2).ClearContents
    Bsh.Cells(Target.Row, Target.Column + 3).ClearContents
    Bsh.Cells(Target.Row, Target.Column + 4).ClearContents
    End If
    Next
    End If
L2:
End Sub

4-2.別シートの一覧表情報をプルダウンリストで表示するマクロ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Ash  As Worksheet
    Set Ash = Sheets("プルダウン一覧")
    Dim Bsh  As Worksheet
    Set Bsh = Sheets("データシート")
    gyo1 = Ash.Cells(Rows.Count, 2).End(xlUp).Row
    gyo2 = Ash.Cells(Rows.Count, 3).End(xlUp).Row
    gyo3 = Ash.Cells(Rows.Count, 4).End(xlUp).Row
    gyo31 = Ash.Cells(Rows.Count, 5).End(xlUp).Row
    gyo32 = Ash.Cells(Rows.Count, 6).End(xlUp).Row
    gyo4 = Bsh.Cells(Rows.Count, 4).End(xlUp).Row + 10
    gyo5 = Bsh.Cells(Rows.Count, 5).End(xlUp).Row + 10
    gyo6 = Bsh.Cells(Rows.Count, 6).End(xlUp).Row + 10
    gyo7 = Bsh.Cells(Rows.Count, 7).End(xlUp).Row + 10
    gyo8 = Bsh.Cells(Rows.Count, 8).End(xlUp).Row + 10
    Bsh.Range(Bsh.Cells(2, 4), Bsh.Cells(gyo4, 4)).Validation.Delete
    If Target.Column = 4 Then
    risuto1 = WorksheetFunction.Transpose(Ash.Range(Ash.Cells(3, 2), Ash.Cells(gyo1, 2)))
    With Target.Validation
    .Add Type:=xlValidateList, Formula1:=Join(risuto1, ",")
    .ShowError = False
    End With
    Else
    End If
    Bsh.Range(Bsh.Cells(3, 5), Bsh.Cells(gyo5, 5)).Validation.Delete
    If Target.Column = 5 Then
    risuto2 = WorksheetFunction.Transpose(Ash.Range(Ash.Cells(3, 3), Ash.Cells(gyo2, 3)))
    With Target.Validation
    .Add Type:=xlValidateList, Formula1:=Join(risuto2, ",")
    .ShowError = False
    End With
    For i = 3 To gyo2
    If (Bsh.Cells(Target.Row, Target.Column) = Ash.Cells(i, 3)) And (Bsh.Cells(Target.Row, Target.Column - 1) = Ash.Cells(i, 2)) Then
    Bsh.Cells(Target.Row, Target.Column + 1) = Ash.Cells(i, 4)
    Bsh.Cells(Target.Row, Target.Column + 2) = Ash.Cells(i, 5)
    Bsh.Cells(Target.Row, Target.Column + 3) = Ash.Cells(i, 6)
    Else
    End If
    Next
    Else
    End If
End Sub

サンプルコードをコピーして「データシート」に貼り付けてください。

隣のセルに自動入力するマクロの導入がこれで完了です。

データシートで「会社名」と「氏名」を入力すると「身長」「体重」「性格」の情報が自動入力されるはずです。お試しください。

上記のように、自分でコードを入力して隣のセルに自動入力するマクロを導入する以外に、

隣のセルに自動入力するマクロが設定されたエクセルファイルをダウンロードして導入する

という方法があります。

コードをコピペする！様式を設定する！などの手間は一切必要ありません。

エクセルファイルをダウンロードするだけで上記で紹介しているサンプルマクロを利用することができます。

＞＞＞　隣のセルに自動入力するマクロのダウンロードはこちら

サンプルマクロには「隣のセルに自動入力するマクロ」以外に、

条件によってテキストを削除するマクロ、別シートの情報を取得するマクロなどが設定されていますので是非参考にしてみてください。