| |
姓と名の間のスペースに規則性があるなら、
検索する姓と名を連結してから、完全一致で検索すればヒットするはずです。
仮にそうした規則性がなく、姓と名とを別々にチェックせざるを得ないなら、
部分一致検索を使って、次のような感じになるのではないですか？
(ただし、姓と名のケースによっては上手くいかないケースがあるかもしれません。
例えば、「太」で「太一」にマッチしてしまうとかですね。
そうしたケースが頻出するなら、そのための対応が必要ですが、
とりあえずコードを作ってみました。参考になれば。）
Sub 検索結果()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim name1 As String
Dim name2 As String
Dim fnd As Range
Dim flag As Boolean
Dim firstAddress As String
Dim r As Long
'検索シート(ws2)、一覧シート(ws1)を省略形
Set ws1 = Worksheets("一覧")
Set ws2 = Worksheets("検索")
'氏名を検索
name1 = ws2.Range("A1").Value
name2 = ws2.Range("A2").Value
'一覧シートの氏名を検索
flag = False
With ws1.Columns("A")
Set fnd = .FIND(what:=name1, lookat:=xlPart)
If Not fnd Is Nothing Then
firstAddress = fnd.Address
If InStr(fnd.Value, name2) > 0 Then
flag = True
Else
Do
Set fnd = .FindNext(fnd)
If InStr(fnd.Value, name2) > 0 Then
flag = True
Exit Do
End If
Loop While Not fnd Is Nothing And fnd.Address <> firstAddress
End If
End If
End With
'氏名が存在すれば､行番号を取得
If flag = True Then
r = fnd.Row
'検索シートに結果を表示
ws2.Cells(1, 3).Value = ws1.Cells(r, 3).Value '社名
ws2.Cells(1, 4).Value = ws1.Cells(r, 4).Value '住所
ws2.Cells(1, 5).Value = ws1.Cells(r, 5).Value '電話番号
ws2.Activate
Else
MsgBox "該当するデータがありません"
End If
End Sub
本来は、姓と名の間を（例えば）全角空白ひとつに限定することとし、
これに沿って元データを作り直しておくのが、良いと思います。
こうすれば、検索する姓と名を全角空白を含めて連結してから、
完全一致で検索すればヒットするわけですから、悩む必要がありません。
なお、貴兄の変数宣言の方法はまちがいです。
>Dim TanNo, FIND As String
とすると、String型なのはFindだけで、TanNoはVariant型です。
それぞれ型宣言する必要があります。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
