エクセル　マクロ　条件に伴った入力を行う

Question

エクセル、マクロ初心者です。
お手柔らかにお願い致します。
作成しようとしているマクロが基礎勉強中の私だと難易度が高いらしく、
何度も質問させて頂いております。申し訳ございません。

{現状}
・毎月行うリストの作成をマクロで行えるように試行錯誤中です。
{実行したい操作}
・B列C列のセルの入力内容によってA列の"担当者名"を自動入力したいと考えております。
・画像にございます、B列の"曜日"とC列の"数字"の組み合わせによって計10人前後の担当者名を使い分け入力判断ができるマクロを作成したいです。
{例}
齋藤　＝　火　＋　2
伊藤　＝　火　＋　3
これも齋藤　＝　水　　＋　2
加藤　＝　水　＋　3
※余談ですが、数字の方は語尾に"号"がつきます。

検索のヒントやサンプルコード、解説など頂けると幸いです。
ちなみに、私はIF～Thenでできるのかな...と過信しています。

ご教授、お願い致します。

tatsu99 · Accepted Answer

前回、登録したマクロは全て削除してください。（削除しないと誤動作します）
以下のマクロを標準モジュールへ登録してください。
-----------------------------------------------------
Option Explicit

Dim row1max As Long
Dim sh1 As Worksheet

Public Sub 担当者設定()
    Dim row As Long
    Dim rowMax As Long
    Dim sh2 As Worksheet
    Set sh1 = Worksheets("担当者マスター")      'シート名変更時、この箇所を変える
    Set sh2 = Worksheets("Sheet1")              'シート名変更時、この箇所を変える
    row1max = sh1.Cells(Rows.Count, 1).End(xlUp).row
    rowMax = sh2.Cells(Rows.Count, 2).End(xlUp).row
    For row = 2 To rowMax
        sh2.Cells(row, 1).Value = GetMemberName(sh2.Cells(row, 2).Value, sh2.Cells(row, 3).Value)
    Next
    MsgBox ("処理完了")
End Sub

Private Function GetMemberName(ByVal week As String, ByVal number As Long)
    Dim row1 As Long
    GetMemberName = ""
    For row1 = 2 To row1max
        If sh1.Cells(row1, 2).Value = week And sh1.Cells(row1, 3).Value = number Then
            GetMemberName = sh1.Cells(row1, 1).Value
            Exit Function
        End If
    Next
End Function
---------------------------------------------------------
Sheet1の曜日、号車で担当者マスターを検索し、該当担当者をsheet1の担当者に設定します。
該当担当者が見つからない場合、空白を設定します。その場合は、曜日、号車に誤りがないか
ご確認をお願いいたします。
尚、Sheet1の名称を変える場合は、
 Set sh2 = Worksheets("Sheet1")              'シート名変更時、この箇所を変える
の箇所を変えてください。（変える方法は担当者マスターと同じです）
Sheet1の行数が１０００行以内であれば、問題ありませんが、
大幅に多い場合は、問題になるかもしれません。その場合は、補足してください。

tatsu99 · Answer

No1です。
>このリストはあるソフトからCSVで書き出したもので、既に存在するものを削除したり並び替えたりして作成しているものでして、Sheet1であるリストのメインとなる箇所には既に曜日と号車が全て記載されていることになってしまうんです。
ということは、Sheet1には、曜日と号車は既に記載されているので、その状態で、マクロを呼び出したときに、
A列へ該当担当者を一気に設定したいということでしょうか。

tatsu99 · Answer

別途、別のシート（担当者マスターとします）に、担当者と曜日、号車の組み合わせを作成しておきます。

（添付の図を参照）
今回、入力をしているシートに以下のマクロを記述します。（標準モジュールではありません）
------------------------------------------------------
Option Explicit

Private Sub Worksheet_Change(ByVal target As Range)
'MsgBox (target.Count & ":" & target.row & ":" & target.Column)
If target.Count > 1 Then Exit Sub
If target.row = 1 Then Exit Sub
If target.Column <> 2 And target.Column <> 3 Then Exit Sub
Application.EnableEvents = False
Call MyChange(target)
Application.EnableEvents = True

End Sub

Private Sub MyChange(ByVal target As Range)
Dim row As Long
Dim row1max As Long
Dim row1 As Long
Dim sh1 As Worksheet
row = target.row
If Cells(row, 2).Value = "" Then
Cells(row, 1).Value = ""
Exit Sub
End If
If Cells(row, 3).Value = "" Then
Cells(row, 1).Value = ""
Exit Sub
End If
Set sh1 = Worksheets("担当者マスター") 'シート名変更時、この箇所を変える
row1max = sh1.Cells(Rows.Count, 1).End(xlUp).row
For row1 = 2 To row1max
If sh1.Cells(row1, 2).Value = Cells(row, 2).Value And sh1.Cells(row1, 3).Value = Cells(row, 3).Value Then
Cells(row, 1).Value = sh1.Cells(row1, 1).Value
Exit Sub
End If
Next
MsgBox ("該当者なし")
End Sub
--------------------------------------------------------------
曜日（B列）と号車（C列）が入力されたとき、担当者マスターから、該当する担当者を検索して、
A列に表示します。
尚、”担当者マスター”の名称は、あなたのほうで好きな名前に変えても、問題ありませんが、
例えば、シート名を○○にした場合は、マクロ中の
Set sh1 = Worksheets("担当者マスター") 'シート名変更時、この箇所を変える
の"担当者マスター"を○○に変えてください。
担当者マスターも
A列：担当者
B列：曜日
C列：号車
となっています。

エクセル マクロ 条件に伴った入力を行う

前回、登録したマクロは全て削除してください。

No1です。

別途、別のシート（担当者マスターとします）に、担当者と曜日、号車の組み合わせを作成しておきます。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

エクセル　マクロ　条件に伴った入力を行う