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

解決済みの質問

EXCEL VBA 文字列検索とコピー

以前にも同じ質問をさせて頂いたのですが、どうも上手くいかないので今一度お願い致します!

名簿を作成していて、現在下記のようなシートになっています。

[ Sheet1 ]
A   B   C   D   E   F   G   H
日付 ○  ○  ○  ○  名前 電話 メール

このF列の名前を検索して、検索文字に該当する全てのセルの行ごと(出きればA1:H2の範囲)コピーして、Sheet2に貼り付けたいです。

現在のコードは、以下のようになってます。
宜しくお願いします!!

Sub 検索1()

Dim myFind As Variant
Dim myfRow As Long, c As Range
Dim CopySh As Worksheet
Dim i As Long
Dim num As Integer

Set CopySh = Worksheets("Sheet2")
'コピー先のセルの最初の行
i = 1
'==================================

myFind = Application.InputBox("検索文字をカナで入力してください", Type:=2)

If VarType(myFind) = vbBoolean Or myFind = "" Then Exit Sub

With Worksheets("Sheet1").Cells(4.4)
Set c = .Find(myFind, , xlValues, xlWhole)
If Not c Is Nothing Then
myfRow = c.Row
Do
c.Copy CopySh.Cells(i, 1) 'コピー
Set c = .FindNext(c)
i = i + 1
Loop Until c Is Nothing Or myfRow = c.Row
End If
End With
Beep '終了の合図

投稿日時 - 2005-08-07 18:23:38

QNo.1565482

暇なときに回答ください

質問者が選んだベストアンサー

こんばんは。

Wendy02です。それは、私の書いたものですね。

>(出きればA1:H2の範囲)コピーして、
ということは、2行という意味ですか?
ロジックで考えると、それは1行の間違いでは?
最初の項目行は、ご自身でコピーしてください。(なくても、最初の行は変わりません。)

これでいかがでしょうか?

Sub 検索2()
 Dim myFind As Variant
 Dim myfRow As Long, c As Range
 Dim CopySh As Worksheet
 Dim i As Long
 Dim num As Integer
 Set CopySh = Worksheets("Sheet2")
 'コピー先のセルの最初の行
 i = CopySh.Range("A65536").End(xlUp).Offset(1).Row
 '==================================
 myFind = Application.InputBox("検索文字をカナで入力してください", Type:=2)
 If VarType(myFind) = vbBoolean Or myFind = "" Then Exit Sub
 With Worksheets("Sheet1").Range("F:F")
  Set c = .Find(myFind, , xlValues, xlWhole)
  If Not c Is Nothing Then
   myfRow = c.Row
   Do
    Range(Cells(c.Row, 1), Cells(c.Row, 8)).Copy _
       CopySh.Cells(i, 1)
    Set c = .FindNext(c)
    i = CopySh.Range("A65536").End(xlUp).Offset(1).Row
   Loop Until c Is Nothing Or myfRow = c.Row
  End If
 End With
 Beep '終了の合図
End Sub

投稿日時 - 2005-08-07 21:31:12

補足

先日は有難うございました♪
A1:H2は、A1:H1の間違いです・・・。

それで、教えて頂いたとおりにやってみましたが(教えて頂いた内容をまるまるコピー)、Sheet2へコピーされません。
どうしてでしょう・・・。
何が考えられますか??

投稿日時 - 2005-08-08 00:17:34

お礼

Set c = .Find(myFind, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, MatchByte:=False, SearchFormat:=False)

に書き換えたら出来ました!!
本当に助かりました!!!
今度からは自分でも勉強します。でもまた困った時はお願いします!

投稿日時 - 2005-08-08 00:34:14

ANo.1

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

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

回答(2)

ANo.2

私は急ぐときは、Findメソッドはなるべく使わないようにしています。
仕事に使うときは、気がせいて、何十分もテストしてられない場合が多い。Findnextというものと組み合わせ使用になり、終わりの判定が難しいからです。
いっそ、全行を検索対象にせねばならないのなら、総なめ法をとると、ロジックが簡単になります。
質問者としては、乗りかけた船、聞いていることに答えてほしいでしょうが
私は行数が多くなければ下記をお勧めします。
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
j = 2
nm = InputBox("検索氏名")
For i = 2 To d
If sh1.Cells(i, "F") = nm Then
sh2.Cells(j, "A") = sh1.Cells(i, "A")
sh2.Cells(j, "B") = sh1.Cells(i, "B")
sh2.Cells(j, "C") = sh1.Cells(i, "C")
sh2.Cells(j, "D") = sh1.Cells(i, "D")
sh2.Cells(j, "F") = sh1.Cells(i, "F") '列の数だけ増やすこと
j = j + 1
End If
Next i
End Sub
コマンドボタンのクリックイベントにでも貼り付けておくと使いやすく
なります。

投稿日時 - 2005-08-07 23:05:05

補足

有難う御座います!
教えて頂いたものでは、検索先の内容と完全に一致するものしか、コピーしてくれませんでした。
僕のやり方がまずいのかな・・・。
検索先のセルの内容に、検索文字が含まれる場合は全て抽出したいのですが・・・。

投稿日時 - 2005-08-08 00:23:52

お礼

有難うございました!
勉強になりました。
また困ったときには、宜しくお願いします!

投稿日時 - 2005-08-08 00:35:15

あなたにオススメの質問