こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

VBA(ExecuteExcel4Macro)を用いた検索ツール

VBA(ExecuteExcel4Macro)を用いた検索ツール

はじめまして。
当方Excel2007、winXPでの環境下でVBAを用いた検索ツールを作成しています。
検索対象のxlsファイルには1行目に郵便番号、氏名、住所の項目タイトル、2行目以降にデータが入力されています。

【現在の仕様】
検索対象のxlsファイルを選択→検索したい氏名(3つまで)を入力すると氏名列を順に検索し、該当した氏名のみをシートへ出力

【作りたい仕様】
検索対象のxlsファイルを選択→検索したい氏名(3つまで)を入力すると氏名列を順に検索し、該当した氏名の入力された行をシートへ出力


現在のソースは下記になりますが、どのように書き変えればいいのかが分からず困っています。
教えていただけたらと思います。よろしくお願いいたします。

-------------------------
(略)
''対象ブックを選択します
OpenFileName = Application.GetOpenFilename("Microsoft Excel ブック,*.xls")
If OpenFileName = "False" Then Exit Sub
OpenFileName = Replace(OpenFileName, Dir(OpenFileName), "[" & Dir(OpenFileName) & "]")
SheetName = InputBox("読み込むワークシート名を入力してください。")
If SheetName = "" Then Exit Sub
Target = "'" & OpenFileName & SheetName & "'!"
On Error Resume Next
buf = ExecuteExcel4Macro(Target & "R1C1")

If Err <> 0 Then
MsgBox "ワークシート [ " & SheetName & " ] を読めませんでした。", vbExclamation
Exit Sub
End If
On Error GoTo 0
key1 = InputBox("検索したい氏名1を入力してください。")
If key1 = "" Then
Exit Sub
End If
key2 = InputBox("検索したい氏名2を入力してください。")
If key2 = "" Then
Else
key3 = InputBox("検索したい氏名3を入力してください。")
End If
For i = 1 To 256
If ExecuteExcel4Macro(Target & "R1C" & i) = "名前" Then
TargetCol = i
Exit For
End If
Next i
If TargetCol = 0 Then
MsgBox "[ 名前 ]フィールドが見つかりません。", vbExclamation
Exit Sub
End If
Dim clm As Integer
For i = 2 To 10000
buf = ExecuteExcel4Macro(Target & "R" & i & "C" & Target
If buf = "0" Then Exit For
If buf = key1 Then
Sheet3.Cells(w, 3) = buf
w = w + 1
ReDim Preserve GetNames(i - 1)
GetNames(i - 1) = buf
ElseIf buf = key2 Then
Sheet3.Cells(w, 3) = buf
w = w + 1
ReDim Preserve GetNames(i - 1)
GetNames(i - 1) = buf
(略)
-----------------

投稿日時 - 2010-09-11 22:55:57

QNo.6175698

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

回答(1)

ANo.1

質問の文言、及び提示のコードにはいくつか問題点がありますが、
ま、それは置いといて。。。

●郵便番号、氏名、住所、、、と並んでいたら

----------------------------
If buf = key1 Then
Sheet3.Cells(w, 2) = ExecuteExcel4Macro(Target & "R" & i & "C" & TargetCol - 1)
Sheet3.Cells(w, 3) = buf
Sheet3.Cells(w, 4) = ExecuteExcel4Macro(Target & "R" & i & "C" & TargetCol + 1)
----------------------------

以上です。
 

投稿日時 - 2010-09-12 18:09:07

あなたにオススメの質問