申請を受けた内容をExcelに転記し、組織名称を入力するなど、人事では様々なタイミングで組織名称を入力する機会があります。

組織名称は会社で決まっているものなので、できれば入力の手間を省きたいですよね!

ということで、今回はExcelの中で組織名称の絞り込みを行うプログラムを紹介します。 

 

組織の絞り込みとは・・・?!

まずはこちらをご覧ください。※BGMありますので、音量ご注意ください。←内容とは関係ないです

OrgシートにDivision・Department・Sectionの三階層の組織情報を記載しています。

このシートの情報より、ListシートのDivision→Sectionまでの入力作業を簡略化しているものです。

わたしの会社では、Division(部門)、Department(部)、Section(課)と分かれていますので、以降、部門/部/課と表現します。(組織名称は(仮)です)  

組織情報の入力について

部門名に「管理」と入力すると、Orgシートの部門名より、経営管理部門と生産管理部門の二つの部門がピックアップされます。 入力した文字から部分一致で部門名を抽出し、リストボックスで検索できるようにするというものです。

  部門名を選択すると、自動で右の行に遷移します。 そして、当該部門名の中に存在する部名がプルダウンで表示されます。

  課名についても同じく、部名に応じて自動的にプルダウン表示となります。便利ですね。

  課名まで入力が終わったら、入力済み部門/部/課名より、組織コード/所属長ID・氏名を自動で表示します。

 

部門名が一致しないケース

部門名称を検索して、一致しないケースも想定しています。 あああああ組織と入力して、Enterを押すと、、

  「該当する組織名が存在しません!!」と表示されます。 何かしら一致するような文字を入力して検索してくださいね!

 

サンプルファイル

以下のファイルをダウンロードして動作をご確認ください。

 

サンプルコード

ワークシートのイベントプロシージャ

上記サンプルのListシートに記載しているコードです。 このコードで、Orgシートの情報を読み取って、Listシートで絞り込みを行っています。

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next

    Dim targetCnt, orgCnt As Long: targetCnt = 0
    Dim varidationStr, divStr, depStr, secStr  As String: varidationStr = ""
    Dim ws, wsOrg As Worksheet
    Set ws = ThisWorkbook.Worksheets("List")
    Set wsOrg = ThisWorkbook.Worksheets("org")
    Dim masterEndRow, iDiv, iDep, iSec As Long
    Dim orgArray, hakenStr, orgStr, divArray, depArray, secArray As Variant
    
    ' -----------------------------
    ' 情報取得
    ' -----------------------------
    ' orgシートの最下行を取得(A列)
    masterEndRow = wsOrg.Cells(Rows.Count, 1).End(xlUp).Row
    ' 組織情報をすべて配列に格納
    orgArray = wsOrg.Range("A2:F" & masterEndRow)
    divArray = wsOrg.Range("A2:A" & masterEndRow)
    depArray = wsOrg.Range("B2:B" & masterEndRow)
    secArray = wsOrg.Range("C2:C" & masterEndRow)
    
    ' Listの書き込み列
    Const orgCd = "F"
    Const bossId = "G"
    Const bossNm = "H"
    
    ' 複数選択の場合、処理停止
    If Target.Count > 1 Then
        Exit Sub
    End If
        
    ' -----------------------------
    ' Division
    ' -----------------------------
    If Selection.Column = "3" Then
        For iDiv = 1 To masterEndRow
            orgStr = orgArray(iDiv, 1)
            orgCnt = orgCnt + 1
            ' 入力内容がマスタと完全一致する場合、一つのDivision名でバリデーション設定
            If orgStr = Target.Value Then
                varidationStr = orgStr
                targetCnt = targetCnt + 1
                ' Division名が一致したら、Department名を入力する
                GoTo INPUT_DEP_NAME
            ' 入力内容がマスタと部分一致する場合、文字列結合し、バリデーション設定
            ElseIf orgStr Like "*" & Target.Value & "*" Then
                If targetCnt = 0 Then
                    varidationStr = orgStr
                Else
                    ' orgStrが前に出てきた文字列でなければ追加
                    If findNumber(CStr(varidationStr), CStr(orgStr)) <> 1 Then
                        varidationStr = varidationStr & "," & orgStr
                    End If
                End If
                targetCnt = targetCnt + 1
            End If
        Next
        
        If targetCnt = 0 Then
            Application.EnableEvents = False
            Target.Value = "該当する組織名が存在しません!!"
            Application.EnableEvents = True
            Exit Sub
        ElseIf targetCnt = 1 Then
            Application.EnableEvents = False
            Target.Value = varidationStr
            Application.EnableEvents = True
            Exit Sub
        Else
            ' リスト設定
            With Target.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertInformation, _
                Operator:=xlBetween, Formula1:=varidationStr
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .IMEMode = xlIMEModeNoControl
                .ShowInput = True
                .ShowError = False
            End With
            Target.Select
            SendKeys "%{DOWN}"
        End If
     
    ' -----------------------------
    ' Department
    ' -----------------------------
    ElseIf Selection.Column = "4" Then
        For orgCnt = 1 To UBound(divArray)
            ' DivisionとDepartmentの名前がマスタと完全一致する場合、Sectionをバリデーション設定する
            If depArray(orgCnt, 1) = Target.Value And divArray(orgCnt, 1) = Target.Offset(0, -1).Value Then
                ' Division名/Department名が一致したら、Section名を入力する
                GoTo INPUT_SEC_NAME
            ' 入力内容がマスタと部分一致する場合、文字列結合し、バリデーション設定
            ElseIf depArray(orgCnt, 1) Like "*" & Target.Value & "*" And divArray(orgCnt, 1) = Target.Offset(0, -1).Value Then
                If targetCnt = 0 Then
                    varidationStr = depArray(orgCnt, 1)
                Else
                    ' orgStrが前に出てきた文字列でなければ追加
                    If findNumber(CStr(varidationStr), CStr(depArray(orgCnt, 1))) <> 1 Then
                        varidationStr = varidationStr & "," & depArray(orgCnt, 1)
                    End If
                End If
                targetCnt = targetCnt + 1
            End If
        Next
        
        If targetCnt = 0 Then
            Application.EnableEvents = False
            Target.Value = "該当する組織名が存在しません!!"
            Application.EnableEvents = True
            Exit Sub
        ElseIf targetCnt = 1 Then
            Application.EnableEvents = False
            Target.Value = varidationStr
            Application.EnableEvents = True
            Exit Sub
        Else
            ' リスト設定
            With Target.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertInformation, _
                Operator:=xlBetween, Formula1:=varidationStr
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .IMEMode = xlIMEModeNoControl
                .ShowInput = True
                .ShowError = False
            End With
            Target.Select
            SendKeys "%{DOWN}"
        End If

    ' -----------------------------
    ' Section入力後、組織コード・所属長ID/氏名入力
    ' -----------------------------
    ElseIf Selection.Column = "5" And Target.Value <> "" Then
        
        ' 組織コード
        If ws.Range(orgCd & Target.Row).Value = "" Then
            ws.Range(orgCd & Target.Row).NumberFormatLocal = "G/標準"
            ws.Range(orgCd & Target.Row).Formula = "=XLOOKUP(C" & Target.Row & "&D" & Target.Row & "&E" & Target.Row & ",'Org'!$A:$A&'Org'!$B:$B&'Org'!$C:$C,'Org'!$F:$F)"
            ws.Range(orgCd & Target.Row).Value = ws.Range(orgCd & Target.Row).Value
        End If
        ' 所属長ID
        If ws.Range(bossId & Target.Row).Value = "" Then
            ws.Range(bossId & Target.Row).NumberFormatLocal = "G/標準"
            ws.Range(bossId & Target.Row).Formula = "=TEXT(XLOOKUP(C" & Target.Row & "&D" & Target.Row & "&E" & Target.Row & ",'Org'!$A:$A&'Org'!$B:$B&'Org'!$C:$C,'Org'!$D:$D,'Org'!$D:$D),""0000000000"")"
            ws.Range(bossId & Target.Row).NumberFormatLocal = "@"
            ws.Range(bossId & Target.Row).Value = ws.Range(bossId & Target.Row).Value
        End If
        ' 所属長名
        If ws.Range(bossNm & Target.Row).Value = "" Then
            ws.Range(bossNm & Target.Row).NumberFormatLocal = "G/標準"
            ws.Range(bossNm & Target.Row).Formula = "=XLOOKUP(C" & Target.Row & "&D" & Target.Row & "&E" & Target.Row & ",'Org'!$A:$A&'Org'!$B:$B&'Org'!$C:$C,'Org'!$E:$E)"
            ws.Range(bossNm & Target.Row).Value = ws.Range(bossNm & Target.Row).Value
        End If
    
    ' -----------------------------
    ' Section入力後、組織コード・所属長ID/氏名入力
    ' -----------------------------
    ElseIf Selection.Column = "6" And Target.Value = "" Then
        
        ' 組織コード
        If ws.Range(orgCd & Target.Row).Value = "" Then
            ws.Range(orgCd & Target.Row).NumberFormatLocal = "G/標準"
            ws.Range(orgCd & Target.Row).Formula = "=XLOOKUP(C" & Target.Row & "&D" & Target.Row & "&E" & Target.Row & ",'Org'!$A:$A&'Org'!$B:$B&'Org'!$C:$C,'Org'!$F:$F)"
            ws.Range(orgCd & Target.Row).Value = ws.Range(orgCd & Target.Row).Value
        End If
        ' 所属長ID
        If ws.Range(bossId & Target.Row).Value = "" Then
            ws.Range(bossId & Target.Row).NumberFormatLocal = "G/標準"
            ws.Range(bossId & Target.Row).Formula = "=TEXT(XLOOKUP(C" & Target.Row & "&D" & Target.Row & "&E" & Target.Row & ",'Org'!$A:$A&'Org'!$B:$B&'Org'!$C:$C,'Org'!$D:$D,'Org'!$D:$D),""0000000000"")"
            ws.Range(bossId & Target.Row).NumberFormatLocal = "@"
            ws.Range(bossId & Target.Row).Value = ws.Range(bossId & Target.Row).Value
        End If
        ' 所属長名
        If ws.Range(bossNm & Target.Row).Value = "" Then
            ws.Range(bossNm & Target.Row).NumberFormatLocal = "G/標準"
            ws.Range(bossNm & Target.Row).Formula = "=XLOOKUP(C" & Target.Row & "&D" & Target.Row & "&E" & Target.Row & ",'Org'!$A:$A&'Org'!$B:$B&'Org'!$C:$C,'Org'!$E:$E)"
            ws.Range(bossNm & Target.Row).Value = ws.Range(bossNm & Target.Row).Value
        End If
    End If
    
    
    Exit Sub

INPUT_DEP_NAME:
        
        ' Departmentのバリデーション設定
        For orgCnt = 1 To UBound(divArray)
            ' Division名の情報と一致するDepartmentを表示する
            If divArray(orgCnt, 1) = varidationStr And IsEmpty(depArray(orgCnt, 1)) = False Then
                ' orgStrが前に出てきた文字列でなければ追加
                If depStr = "" Then
                    depStr = depArray(orgCnt, 1)
                ElseIf findNumber(CStr(depStr), CStr(depArray(orgCnt, 1))) <> 1 Then
                    depStr = depStr & "," & depArray(orgCnt, 1)
                End If
                targetCnt = targetCnt + 1
            End If
            ' Division名の情報と一致し、かつ、Department名がブランクのSection名を表示する
            If divArray(orgCnt, 1) = varidationStr And IsEmpty(depArray(orgCnt, 1)) = True And IsEmpty(secArray(orgCnt, 1)) = False Then
                ' orgStrが前に出てきた文字列でなければ追加
                If secStr = "" Then
                    secStr = secArray(orgCnt, 1)
                ElseIf findNumber(CStr(secStr), CStr(secArray(orgCnt, 1))) <> 1 Then
                    secStr = secStr & "," & secArray(orgCnt, 1)
                End If
            End If
        Next
        
        If targetCnt = 0 Then
            Application.EnableEvents = False
            Target.Value = "該当する組織名が存在しません!!"
            Application.EnableEvents = True
            Exit Sub
        Else
            ' リスト設定
            With Target.Offset(0, 1).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertInformation, _
                Operator:=xlBetween, Formula1:=depStr
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .IMEMode = xlIMEModeNoControl
                .ShowInput = True
                .ShowError = False
            End With
            ' リスト設定
            With Target.Offset(0, 2).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertInformation, _
                Operator:=xlBetween, Formula1:=secStr
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .IMEMode = xlIMEModeNoControl
                .ShowInput = True
                .ShowError = False
            End With
            Target.Offset(0, 1).Select
            SendKeys "%{DOWN}"
        End If

        Exit Sub

INPUT_SEC_NAME:
        
        ' Section名のバリデーション設定
        For orgCnt = 1 To UBound(divArray)
            ' Division名・Department名の情報が一致した場合、Section名をバリデーション設定する
            If depArray(orgCnt, 1) = Target.Value And divArray(orgCnt, 1) = Target.Offset(0, -1).Value Then
            ' orgStrが前に出てきた文字列でなければ追加
                If secStr = "" Then
                    secStr = secArray(orgCnt, 1)
                ElseIf findNumber(CStr(secStr), CStr(secArray(orgCnt, 1))) <> 1 Then
                    secStr = secStr & "," & secArray(orgCnt, 1)
                End If
                targetCnt = targetCnt + 1
            End If
        Next
        
        If targetCnt = 0 Then
            Application.EnableEvents = False
            Target.Offset(0, 1).Value = "該当する組織名が存在しません!!"
            Application.EnableEvents = True
            Exit Sub
        Else
            ' リスト設定
            With Target.Offset(0, 1).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertInformation, _
                Operator:=xlBetween, Formula1:=secStr
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .IMEMode = xlIMEModeNoControl
                .ShowInput = True
                .ShowError = False
            End With
            Target.Offset(0, 1).Select
            SendKeys "%{DOWN}"
        End If

        Exit Sub

End Sub


 

Functionプロシージャ

上記コードの中で、利用しているFunctionプロシージャについて、標準モジュールを追加して以下のコードを記載しています。

' ****************************************
' 文字列の中に指定の文字が何回出てくるか
' string1:検索元の文字列
' string2:検索対象文字列
' 例:findnumber("AAA","A") → 3
' ****************************************
Function findNumber(string1 As String, string2 As String)
    Dim N As Long, cnt As Long
    N = InStr(1, string1, string2)
    Do While N > 0
        cnt = cnt + 1
        N = InStr(N + 1, string1, string2)
    Loop
    findNumber = cnt
End Function

 

さいごに

組織名称の絞り込みができるようになれば、一段階上の管理表になる気がしますよね。 ぜひご活用ください!