エクセルの質問です。

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

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

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

回答の条件
  • URL必須
  • 1人3回まで
  • 登録:2007/08/24 19:53:06
  • 終了:2007/08/30 06:59:43

ベストアンサー

id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912007/08/24 21:29:16

ポイント50pt

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

シート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/

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

id:ASTR

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

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

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

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

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

2007/08/30 06:56:41

その他の回答(1件)

id:takejin No.1

たけじん回答回数1464ベストアンサー獲得回数1892007/08/24 20:50:37

ポイント20pt

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 選択 のときのクリックとは、何をクリックするのでしょうか。

 

id:ASTR

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

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

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

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

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

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

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

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

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

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

2007/08/25 09:45:31
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912007/08/24 21:29:16ここでベストアンサー

ポイント50pt

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

シート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/

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

id:ASTR

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

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

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

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

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

2007/08/30 06:56:41
  • id:takejin
    申し訳ない。
    仕様を書いてもらってから、回答が用意できませんでした。
    Mookさんとは別のアプローチで説明できれば、と思ったんだけど・・・。
    又の機会に。
  • id:ASTR
    いえ、とんでもないですよ。
    とても困っていたので、ご回答頂けるかもしれないというだけで、随分気持ちが助かりました。
    またの機会にも宜しくお願い致します。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません