VBAの「検索」ボタン押下で、複数項目を入力した場合でも検索できるようにしたい

前提・実現したいこと

VBAの「検索」ボタン押下で、複数項目を入力した場合でも検索できるようにしたいです。
現在は単一の項目（名字または役職）のみで検索してデータを取得できるのですが、複数項目（名字、名前、役職、入社年月日、退社年月日、SE経験年数、得意言語）を入力した場合でも、合致するデータを取得して転記したいのですが、どのようにすべきでしょうか。
乱文で申し訳ございません。
アドバイスいただけましたら幸いです。
よろしくお願いいたします。

発生している問題・エラーメッセージ

エラーメッセージ

該当のソースコード

VBA
1Option Explicit
2
3    Dim ID As Integer
4    Dim Name_F As String
5    Dim Name_L As String
6    Dim Role As String
7    Dim Year_E As Integer
8    Dim Month_E As Integer
9    Dim Day_E As Integer
10    Dim Year_L As Integer
11    Dim Month_L As Integer
12    Dim Day_L As Integer
13    Dim Experience As String
14    Dim Language_1 As String
15    Dim Language_2 As String
16    Dim Language_3 As String
17    Dim Language_4 As String
18    
19    
20    Const Col_ID = "A"
21    Const Col_Name_F = "B"
22    Const Col_Name_L = "C"
23    Const Col_Role = "D"
24    Const Col_Year_E = "E"
25    Const Col_Month_E = "F"
26    Const Col_Day_E = "G"
27    Const Col_Year_L = "H"
28    Const Col_Month_L = "I"
29    Const Col_Day_L = "J"
30    Const Col_Experience = "K"
31    Const Col_Language_1 = "L"
32    Const Col_Language_2 = "M"
33    Const Col_Language_3 = "N"
34    Const Col_Language_4 = "O"
35
36Sub Kensaku_Click()
37
38    '変数宣言
39    Dim sht_toroku As Worksheet
40    Dim sht_shain As Worksheet
41    Dim sht_itiran As Worksheet
42    Dim FoundCell As Range
43    Dim LastRow As Integer
44    Dim FirstCell As Range
45    
46    Dim LastRow_shain As Integer
47        
48    Set sht_toroku = Worksheets("社員情報管理_登録")
49    Set sht_shain = Worksheets("社員マスタ")
50    Set sht_itiran = Worksheets("社員情報一覧")
51    
52'    sht_itiran.Range("A2:O1000") = ""
53    sht_itiran.Range("A1").CurrentRegion.Offset(1, 0) = ""
54    
55    LastRow = sht_itiran.Cells(Rows.Count, 2).End(xlUp).Row + 1
56    
57    LastRow_shain = sht_shain.Cells(Rows.Count, 2).End(xlUp).Row
58    
59    If sht_toroku.Range("E3") = "" And sht_toroku.Range("J3") = "" And sht_toroku.Range("E5") = "" _
60        And sht_toroku.Range("E7") = "" And sht_toroku.Range("J7") = "" And sht_toroku.Range("M7") = "" _
61        And sht_toroku.Range("E9") = "" And sht_toroku.Range("J9") = "" And sht_toroku.Range("M9") = "" _
62        And sht_toroku.Range("BA11").Value = "0" And sht_toroku.Range("E13") = "" And sht_toroku.Range("J13") = "" _
63        And sht_toroku.Range("O13") = "" And sht_toroku.Range("T13") = "" Then
64        
65        sht_shain.Range("A2 : O" & LastRow_shain).Copy
66        sht_itiran.Range("A2").PasteSpecial
67        
68        sht_itiran.Activate
69        sht_itiran.Range("A1").Select
70    
71        MsgBox "全件のデータを転記しました"
72        
73        Exit Sub
74            
75    End If
76        
77    '1件目の社員マスタ内のデータを検索
78    If sht_toroku.Range("E3") <> "" Then
79'        Set FoundCell = sht_shain.Range("B:B").Find(sht_toroku.Range("E3").Value)
80        Set FoundCell = sht_shain.Range("B2 : B" & LastRow_shain).Find(sht_toroku.Range("E3").Value)
81    ElseIf sht_toroku.Range("E5") <> "" Then
82        Set FoundCell = sht_shain.Range("D2 : D" & LastRow_shain).Find(sht_toroku.Range("E5").Value)
83    End If
84    
85    If sht_toroku.Range("E3") = "" And sht_toroku.Range("E5") = "" Then
86        MsgBox "名字または役職を入力してください"
87        Exit Sub
88    ElseIf sht_toroku.Range("E3") <> "" And sht_toroku.Range("E5") <> "" Then
89        MsgBox "名字または役職のどちらかで検索してください"
90        sht_toroku.Range("E3") = ""
91        sht_toroku.Range("E5") = ""
92        Exit Sub
93    End If
94    
95    If FoundCell Is Nothing Then
96        MsgBox "検索対象が見つかりませんでした"
97        Exit Sub
98    Else
99    
100    
101        Set FirstCell = FoundCell
102    
103        '社員マスタシートの情報を取得_1件目
104        Call getShainData(sht_shain, FoundCell)
105
106        '取得したデータを社員一覧シートに転記_1件目
107        Call outShainData(sht_itiran, LastRow)
108    End If
109        
110    'ループ Start
111    Do
112        '次の条件に合致するデータの検索
113        Set FoundCell = sht_shain.Cells.FindNext(FoundCell)
114        
115        '検索条件に合致するデータを検索し終わった場合、終了
116        If FoundCell.Address = FirstCell.Address Then
117            Exit Do
118        Else
119            '社員マスタシートの情報を取得_2件目以降
120            Call getShainData(sht_shain, FoundCell)
121        
122            '取得したデータを社員一覧シートに転記_2件目以降
123            Call outShainData(sht_itiran, LastRow)
124        End If
125    Loop
126    
127    
128    sht_itiran.Activate
129    
130    MsgBox "検索処理が終了し、合致するデータを転記しました"
131    
132        
133'    Else
134'        Set FirstCell = FoundCell
135'        FoundCell.Resize(1, 14).Copy sht_itiran.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
136'    End If
137'    Do
138'        Set FoundCell = Cells.FindNext(FoundCell)
139'        If FoundCell.Address = FirstCell.Address Then
140'            Exit Do
141'        Else
142'            FoundCell.Resize(1, 14).Copy sht_itiran.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
143'        End If
144'    Loop
145    
146End Sub
147
148Sub getShainData(sht_shain As Worksheet, FoundCell As Range)
149
150        ID = sht_shain.Cells(FoundCell.Row, Col_ID).Value
151        Name_F = sht_shain.Cells(FoundCell.Row, Col_Name_F).Value
152        Name_L = sht_shain.Cells(FoundCell.Row, Col_Name_L).Value
153        Role = sht_shain.Cells(FoundCell.Row, Col_Role).Value
154        Year_E = sht_shain.Cells(FoundCell.Row, Col_Year_E).Value
155        Month_E = sht_shain.Cells(FoundCell.Row, Col_Month_E).Value
156        Day_E = sht_shain.Cells(FoundCell.Row, Col_Day_E).Value
157        Year_L = sht_shain.Cells(FoundCell.Row, Col_Year_L).Value
158        Month_L = sht_shain.Cells(FoundCell.Row, Col_Month_L).Value
159        Day_L = sht_shain.Cells(FoundCell.Row, Col_Day_L).Value
160        Experience = sht_shain.Cells(FoundCell.Row, Col_Experience).Value
161        Language_1 = sht_shain.Cells(FoundCell.Row, Col_Language_1).Value
162        Language_2 = sht_shain.Cells(FoundCell.Row, Col_Language_2).Value
163        Language_3 = sht_shain.Cells(FoundCell.Row, Col_Language_3).Value
164        Language_4 = sht_shain.Cells(FoundCell.Row, Col_Language_4).Value
165
166End Sub
167
168Sub outShainData(sht_itiran As Worksheet, LastRow As Integer)
169
170        sht_itiran.Range("A" & LastRow).Value = ID
171        sht_itiran.Range("B" & LastRow).Value = Name_F
172        sht_itiran.Range("C" & LastRow).Value = Name_L
173        sht_itiran.Range("D" & LastRow).Value = Role
174        sht_itiran.Range("E" & LastRow).Value = Year_E
175        sht_itiran.Range("F" & LastRow).Value = Month_E
176        sht_itiran.Range("G" & LastRow).Value = Day_E
177        sht_itiran.Range("H" & LastRow).Value = Year_L
178        sht_itiran.Range("I" & LastRow).Value = Month_L
179        sht_itiran.Range("J" & LastRow).Value = Day_L
180        sht_itiran.Range("K" & LastRow).Value = Experience
181        sht_itiran.Range("L" & LastRow).Value = Language_1
182        sht_itiran.Range("M" & LastRow).Value = Language_2
183        sht_itiran.Range("N" & LastRow).Value = Language_3
184        sht_itiran.Range("O" & LastRow).Value = Language_4
185        
186        LastRow = LastRow + 1
187
188End Sub

試したこと

ここに問題に対して試したことを記載してください。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

行動規範の内容に同意します

回答1件

ベストアンサー

VBA
1Sub Sample()
2
3    
4    Dim sht_toroku As Worksheet
5    Set sht_toroku = Worksheets("社員情報管理_登録")
6    Dim 検索条件, arr(7)
7    With sht_toroku
8        arr(0) = .Range("A2") 'ID
9        arr(1) = .Range("B2") '名字
10        arr(2) = .Range("C2") '名前
11        arr(3) = .Range("D2") '役職
12        arr(4) = .Range("E2") '入社年月日
13        arr(5) = .Range("F2") '退社年月日
14        arr(6) = .Range("G2") 'SE経験年数
15        arr(7) = .Range("H2") '得意言語
16    End With
17    検索条件 = Join(arr, "*,*")
18    
19    
20    Dim sht_shain As Worksheet
21    Set sht_shain = Worksheets("社員マスタ")
22    
23    Dim r As Range, 社員データ
24    Dim 抽出結果 As New Dictionary
25    
26    For Each r In sht_shain.UsedRange.Rows
27        社員データ = WorksheetFunction.TextJoin(",", False, r.Value)
28        If 社員データ Like 検索条件 Then 抽出結果.Add 抽出結果.Count + 1, r.Value
29    Next
30    
31    
32    Dim sht_itiran As Worksheet
33    Set sht_itiran = Worksheets("社員情報一覧")
34    
35    sht_itiran.Cells.Resize(抽出結果.Count, UBound(arr) + 1).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(抽出結果.Items))
36
37End Sub