Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
3646 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【60964】全文検索と該当セルの取り込みについて カンジ 09/3/27(金) 21:57 発言[未読]
【60965】Re:全文検索と該当セルの取り込みについて neptune 09/3/27(金) 22:19 発言[未読]
【60967】Re:全文検索と該当セルの取り込みについて カンジ 09/3/28(土) 0:37 お礼[未読]
【60968】Re:全文検索と該当セルの取り込みについて kanabun 09/3/28(土) 11:34 発言[未読]
【60969】Re:全文検索と該当セルの取り込みについて カンジ 09/3/28(土) 18:56 お礼[未読]
【60964】全文検索と該当セルの取り込みについて
発言  カンジ  - 09/3/27(金) 21:57 -
引用なし
パスワード
   全文検索について教えてください
同じ値の検索は下記で出来たのですが、全文検索がうまく出来ません。
同じ値の検索は下記で何とかできたのですが、下記のRange("F1")（例えば
「家族」など）を含むセルを検索し取り込む方法が分かりません。
設定の仕方を教えてください。よろしくお願いします。

Sub ワード全文検索()
　　Dim GOOD As String
　　Dim シート名1 As String
　　Dim シート名2 As String
　　シート名1 = "元データ"　　　'検索対象のシート
　　シート名2 = "GOOD情報"　　　'ここに検索したセルを集める
　　GOOD = Worksheets(シート名2).Range("F1")　'F1は家族など　
　　i = 2　　
　　Worksheets(シート名2).Select　　　'検索のセルをシート名2に集めます　
　　Do While Sheets(シート名1).Cells(i, 2) <> ""
　　　　If Sheets(シート名1).Cells(i, 2) = GOOD Then
　　　　'If Columns(2).Find(Worksheets(シート名2).Range("F1").Value) = GOOD Then
　　　
　　　　ActiveSheet.Range("B100").End(xlUp).Offset(1, 0).Select
　　　　Selection.Value = Sheets(シート名1).Cells(i, 3)　　　
　　　　ActiveCell.Offset(0, 1).Value = Sheets(シート名1).Cells(i, 4)
　　　
　　　End If
　　　　i = i + 1
　　Loop
　　　
　　Range("A1").Select
　End Sub
【60965】Re:全文検索と該当セルの取り込みについて
発言  neptune  - 09/3/27(金) 22:19 -
引用なし
パスワード
   ▼カンジ さん：

よく見てないんで勘になるんですが、

>　　　　'If Columns(2).Find(Worksheets(シート名2).Range("F1").Value) = GOOD Then
↑の = を Like演算子に変えてみよう。
１．Helpで「Like 演算子」を検索、全部読む。
２．Like 演算子の使用例を見て参考にしてまねする。
これで（「家族」など）を含む）を判断できるはずです。
【60967】Re:全文検索と該当セルの取り込みについて
お礼  カンジ  - 09/3/28(土) 0:37 -
引用なし
パスワード
   neptuneさん　ありがとうございました
Like演算子を調べて検索が出来る形を作ることが出来ました。
使い方にフィットするような検討を加えて完成させたいと思います。
本当にありがとうございました。感謝します。

▼neptune さん：
>▼カンジ さん：
>
>よく見てないんで勘になるんですが、
>
>>　　　　'If Columns(2).Find(Worksheets(シート名2).Range("F1").Value) = GOOD Then
>↑の = を Like演算子に変えてみよう。
>１．Helpで「Like 演算子」を検索、全部読む。
>２．Like 演算子の使用例を見て参考にしてまねする。
>これで（「家族」など）を含む）を判断できるはずです。
【60968】Re:全文検索と該当セルの取り込みについて
発言  kanabun  - 09/3/28(土) 11:34 -
引用なし
パスワード
   ▼カンジ さん：

すでに Like演算子で解決済みのようですが、
複数セルを抽出するなら オートフィルタを使ってもよいかと思います。

　　Dim GOOD As String
　　Dim c As Range　　　'コピー先セル
　　
　　With Sheets("GOOD情報")　'ここに検索したセルを集める
　　　　GOOD = .Range("F1").Value　'F1は家族など
　　　　Set c = .Range("B1000").End(xlUp).Offset(1) 'コピー先
　　End With
　　With Sheets("元データ")
　　　　.FilterMode = False
　　　　With .Range("A1").CurrentRegion '検索対象のシート
　　　　　　.AutoFilter 2, "*" & GOOD & "*"　 'GOOD を含む文字列の行を抽出
　　　　　　If WorksheetFunction.Subtotal(3, .Columns(2)) > 1 Then
　　　　　　　　Intersect(.Columns("C:D"), .Offset(1)).Copy Destination:=c
　　　　　　End If
　　　　　　.AutoFilter
　　　　End With
　　End With
【60969】Re:全文検索と該当セルの取り込みについて
お礼  カンジ  - 09/3/28(土) 18:56 -
引用なし
パスワード
   kanabun さん
ご指導ありがとうございます。
Like演算子を使って何とか作りましたが、かなり複雑になりました。
今回ご指導いただいた内容で再度作ってみました。
見事にすっきりと検索してくれます。また、範囲などの変更も簡単に
行きそうなので大助かりです。
これをベースにしていきます。ありがとうございました。感謝です。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
3646 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free