Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6000 / 76733

←次へ　｜　前へ→


	【76336】Re:2つの値検索して取得

γ - 14/11/1(土) 10:35 -


	引用なし

	パスワード

姓と名の間のスペースに規則性があるなら、
検索する姓と名を連結してから、完全一致で検索すればヒットするはずです。

仮にそうした規則性がなく、姓と名とを別々にチェックせざるを得ないなら、
部分一致検索を使って、次のような感じになるのではないですか？

(ただし、姓と名のケースによっては上手くいかないケースがあるかもしれません。
例えば、「太」で「太一」にマッチしてしまうとかですね。
そうしたケースが頻出するなら、そのための対応が必要ですが、
とりあえずコードを作ってみました。参考になれば。）

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型です。
それぞれ型宣言する必要があります。

1 hits

▼

【76332】2つの値検索して取得 you 14/11/1(土) 0:31