人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルの質問です。
素人にはハードルが高すぎる様で困っています。
以下の動作をするマクロを教えてください。
また、出来れば出よいので簡単な解説も付けて下さると嬉しいです。

シート1
検索用語「1」
「選択」
シート2
文章A 記号 文章B 記号 Keyword1 Keyword2
あいう え おかき く けこさ しすせ

という形で入力された2つのシートがあり、検索用語「1」に単純に用語を入力すると、
シート1の「1」の横に、
「1」・・・
・・・
という形で、直接用語を含んだ文章とキーワードに用語が含まれる文章が抜き出され、
「1」に入力する用語に*を加えると(=用語*)、
「1」・・・すぐ右の記号
・・・すぐ右の記号
という動作を行わせたいのです。
この際、データは自由に加減できる事と、文章記号の組合わせ、キーワードは増やせなくても
いいので、それぞれ15個は使える事が前提です。
また「選択」ではクリックで選択させて同様の操作を実現できればと思っています。
どうか宜しくお願いします。

●質問者: ASTR
●カテゴリ:コンピュータ 科学・統計資料
✍キーワード:keyword あい エクセル キーワード クリック
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● たけじん
●20ポイント

http://q.hatena.ne.jp/1187952783

すこし、質問文がわかりにくいので。

1 シート1には、検索をかけるキーワードを、検索するときに入力するのでよいのでしょうか。

2 シート2にあらかじめ記載された情報のみの検索ですね。

3 シート2の

文章A 記号 文章B 記号 Keyword1 Keyword2

のどの列も、検索の対象となるのでしょうか。それとも、文章とキーワードのみでしょうか。

4 横1列のどこかにヒットしたら、文章A、文章Bとも表示ですか?それとも、その検索語を含む方の文章のみの表示ですか。

5 用語にくわえる記号は*でなければならないのですか。他の記号に変えてはいけませんか。

6 それぞれ15個、というのは、何が15個なのでしょうか。

7 選択 のときのクリックとは、何をクリックするのでしょうか。

◎質問者からの返答

ご指摘ありがとうございます。

稚拙な文章で申し訳ございません。

1、2に関しまして、その通りです。

3に関しましては、文章とキーワードのみを考えております。

4に関しましては、検索用語を含む文章のみを表示させたいのです。

5に関しましては、記号は何でもかまいません。ただ*が最初に思いついただけなのです。

6ですが、文章と記号を1セットとし最大15個、キーワードを最大15個、それぞれを見出しに使いたいのです。その下の列にデータを入れる形です。

7は、キーワードを予めセットしておき、マウスでクリックするとメニューがでて選択出来るのが理想です。

オートフィルタの様な形が出来ればと思って考えました。

素早いご返答を頂きながらお返事の遅れた事をお詫び致します。


2 ● Mook
●50ポイント ベストアンサー

いまひとつ仕様の解釈に自信がありませんが、一応参考マクロを作成してみました。

シート1のシートモジュール(シートタブを右クリックして「コードを表示」)へ下記を貼り付けてください。


検索語入力位置か検索後選択位置を変更するとマクロが機能します。

追加として、検索結果が文章かキーワードかを判断するために、キーワードは赤い文字で表示しています。

'-------------------------------------------
'--- 検索データシート名
'-------------------------------------------
Const searchSheetName = "シート2"

'-------------------------------------------
'--- 検索語入力位置
'-------------------------------------------
Const inputRange = "B1"
'-------------------------------------------
'--- 検索語選択位置
'-------------------------------------------
Const selectRange = "B2"

'-------------------------------------------
'--- 検索データ:タイトルキーワード
'-------------------------------------------
'- 下記の文字を含むものをそれぞれ、文章、記号、Keyword として扱う
'- 「文章」の隣は必ず「記号」と想定
'-------------------------------------------
Const sentenceTitle = "文章"
Const symbolTitle = "記号"
Const keywordTitle = "Keyword"

'-------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'-------------------------------------------
 Application.EnableEvents = False
 
 Dim aRange As Range
 For Each aRange In Target
'// 検索後入力位置か選択位置のデータが変わったら処理を実行
 If Not Intersect(Target, Union(Range(inputRange), Range(selectRange))) Is Nothing Then
'// 結果のクリア
 Dim lastLine As Long
 lastLine = Range(inputRange).Offset(0, 1).End(xlDown).Row
 Range(inputRange).Offset(0, 1).Resize(lastLine, 2).Clear
'// 検索処理の実行
 searchSentence aRange
 Exit For
 End If
 Next
 Application.EnableEvents = True
End Sub

'-------------------------------------------
Sub searchSentence(sRange As Range)
'-------------------------------------------
 If Len(sRange.Value) = 0 Then
 Exit Sub
 End If

 Dim sWord As String
 Dim isSymbolsMode As Boolean
'// 記号を出力するかどうかを設定
 If InStr(sRange.Value, "*") = Len(sRange.Value) Then
 isSymbolsMode = True
 sWord = Left(sRange.Value, Len(sRange.Value) - 1)
 Else
 isSymbolsMode = False
 sWord = sRange.Value
 End If

'// 検索対象シートを設定
 Dim sWS As Worksheet
 Set sWS = Worksheets(searchSheetName)
 
'// 結果出力位置の設定
 Dim writeBase As Range
 Set writeBase = Range(inputRange).Offset(0, 1)
 Dim writeOffset As Long
 writeOffset = 0
 
'// 検索処理
 Dim c As Long
 Dim r As Long
 Dim lastCol As Long
 lastCol = sWS.Range("IV1").End(xlToLeft).Column
 Dim lastRow As Long
 Dim isSentence As Boolean
'// 1列ごとを検索
 For c = 1 To lastCol

 '// 列の最終行を取得
 lastRow = sWS.Range("A" & Rows.Count).Offset(0, c - 1).End(xlUp).Row

 '// 検索列が文章かの判定
 If InStr(sWS.Cells(1, c).Value, sentenceTitle) > 0 Then
 isSentence = True
 Else
 isSentence = False
 End If

 '// 検索列が記号は、検索をしない
 If InStr(sWS.Cells(1, c).Value, symbolTitle) > 0 Then
 lastRow = 1
 End If

 '// 検索列のを2行目から検索
 For r = 2 To lastRow
 '// 検索語を含んでいたら出力
 If InStr(sWS.Cells(r, c).Value, sWord) > 0 Then
 writeBase.Offset(writeOffset, 0).Value = sWS.Cells(r, c).Value
 
 '// KeyWord は文字列を赤に設定
 If isSentence = False Then
 writeBase.Offset(writeOffset, 0).Font.ColorIndex = 3
 End If
 
 '// 検索列が文章で、* が指定されていたら、記号も出力
 If isSymbolsMode = True And isSentence = True Then
 writeBase.Offset(writeOffset, 1).Value = sWS.Cells(r, c + 1).Value
 End If
 writeOffset = writeOffset + 1
 End If
 Next
 Next
End Sub

http://itpro.nikkeibp.co.jp/article/COLUMN/20060206/228647/

不明な点は、コメントで補足します。

◎質問者からの返答

ご返答が遅れまして申し訳ございません。

素晴らしいご回答を頂きまして、とても感謝いたしております。

これを元に色々と勉強させていただこうと思います。

またの機会がありましたら、これに懲りずに宜しくお願いいたします。

本当にありがとうございました。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ