質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.86%

  • VBA

    1551questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1328questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

VBAでフィルターをかけて、検出対象を別シートへコピーしたい

受付中

回答 1

投稿

  • 評価
  • クリップ 0
  • VIEW 810

linx_0415

score 2

前提・実現したいこと

ログを確認するVBA

シート1 ログ全文
シート2 単語1
シート3 単語2
シート4 単語3

①ログ全文シートに貼り付けられたログ(A列のみ、空白行有り)に「単語1」でフィルターをかける
②検出された行をコピーして、シート2「単語1」へ貼り付ける
③シート1「ログ全文」へ戻り、検出されている行に色をつける
④”単語2”でログをかけなおす
⑤単語が含まれている行が検出された場合のみ、②③同様の作業(シートのみシート3「単語2」になる)を行う。
検出されなかった場合は何も行わない。
⑥”単語3”でログをかけなおす
⑦⑤と同様。(シートのみシート4「単語3」になる)
⑧ファイルを別名保存(保存先:デスクトップ)する

発生している問題・エラーメッセージ

ネット上で探していろいろと試しましたが、
・実行時エラー 438
・実行時エラー 1004
が発生してしまい、同様に調べて原因調査を行いましたが、解決できませんでした。

補足情報(言語/FW/ツール等のバージョンなど)

Excel 2010

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • imihito

    2017/12/21 22:32

    可能であれば使用したコードを質問に追記してください。

    キャンセル

  • linx_0415

    2017/12/22 10:41

    すみません、昨日の段階であきらめて消してしまいました

    キャンセル

回答 1

0

上記要件に即してプログラムを作成しました。
検索単語をシート数の上限まで設定できるようにしたり、
ログが肥大化した際でも高速に処理ができるように工夫してあります。
何か問題があればコメントください。

Option Explicit

' 「シート1 ログ全文」シートのシート名
Private Const SHEET_NAME_LOG_MAIN As String = "ログ全文"

' ログのフィルターを実施
Public Sub FilterLogs()

    ' 変数宣言
    Dim book As Workbook
    Dim sheet As Worksheet
    Dim logSheet As Worksheet
    Dim searchWords As Collection
    Dim searchWord As Variant
    Dim matchedLogs As Collection

    ' 処理対象ブック取得
    Set book = ThisWorkbook

    ' 検索文字列を取得
    ' また検索結果出力シートの初期化も実施
    ' ※シート名を走査し、シート名が SHEET_NAME_LOG_MAIN 以外の全シート名を
    '  検索文字列と認識します。これにより、何項目でも検索することができます
    Set searchWords = New Collection
    For Each sheet In book.Worksheets
        If sheet.Name <> SHEET_NAME_LOG_MAIN Then
            sheet.Cells.Clear
            searchWords.Add sheet.Name
        End If
    Next

    ' 「シート1 ログ全文」シート取得
    Set logSheet = book.Worksheets(SHEET_NAME_LOG_MAIN)

    ' A1セルにフォーカスをあてる(処理後にきれいに見えるため)
    logSheet.Activate
    logSheet.Cells(1, 1).Select

    ' 全検索項目を検索
    For Each searchWord In searchWords

        ' 検索を実施
        Set matchedLogs = SearchMatchedCell(logSheet, CStr(searchWord))

        ' 見つかった場合はシートに吐き出す
        If matchedLogs.Count > 0 Then

            OutputMatchedLogs book.Worksheets(searchWord), matchedLogs

        ' 見つからなかった場合は処理終了
        Else

            MsgBox "「" & searchWord & "」が含まれるログが存在しませんでした " & vbLf & "処理を終了します", vbInformation + vbOKOnly, "処理終了"

            ' ブックをデスクトップに別名保存
            If Not Save(book) Then
                MsgBox "保存に失敗しました。手動で保存してください", vbExclamation + vbOKOnly, "保存失敗"
            End If

            Exit Sub

        End If

    Next

    ' ブックをデスクトップに別名保存
    If Not Save(book) Then
        MsgBox "保存に失敗しました。手動で保存してください", vbExclamation + vbOKOnly, "保存失敗"
    End If

    ' メッセージ出力
    MsgBox "処理が完了しました", vbInformation + vbOKOnly, "処理終了"

End Sub

' 別保存実行
Private Function Save(ByRef book As Workbook) As Boolean

    ' 変数宣言
    Dim path As String

    ' 保存パス取得
    With CreateObject("WScript.Shell")
        path = .SpecialFolders("Desktop") & "\" & Left(book.Name, InStrRev(book.Name, ".") - 1) & "_検索後"
    End With

    ' 保存実行
    On Error Resume Next
    book.SaveAs Filename:=path, FileFormat:=xlOpenXMLWorkbookMacroEnabled

    ' 保存成功有無を返却
    If Err.Number <> 0 Then
        Save = False
    Else
        Save = True
    End If

    On Error GoTo 0

End Function

' 検索結果マッチした文字列を出力
Private Sub OutputMatchedLogs(ByRef sheet As Worksheet, ByRef matchedLogs As Collection)

    ' 変数宣言
    Dim matchedLog As Variant
    Dim outputRow As Long

    ' シートを初期化
    sheet.Cells.Clear

    ' 出力行初期化
    outputRow = 0

    ' 全検索結果を走査
    For Each matchedLog In matchedLogs

        ' 出力行を最新化
        outputRow = outputRow + 1

        ' 検索結果を出力
        sheet.Cells(outputRow, 1).Value = CStr(matchedLog)

    Next

End Sub

' 全セルに対して検索対象文字が含まれるかどうかを検索し含まれる場合にはセル色を変更
' 検索対象文字が含まれるセルの文字列を Collection に詰めて返却
Private Function SearchMatchedCell(ByRef sheet As Worksheet, ByRef word As String) As Collection

    ' 変数宣言
    Dim datas As Variant
    Dim cell As Range
    Dim matchedLogs As Collection
    Dim firstRow As Long
    Dim firstColumn As Long
    Dim i As Long, j As Long

    ' オブジェクト初期化
    Set matchedLogs = New Collection

    With sheet.UsedRange

        ' 全ログを取得
        datas = .Cells

        ' ログ開始行取得
        firstRow = .Cells(1).Row

        ' ログ開始列取得
        firstColumn = Cells(1).Column

    End With

    ' 全セル走査
    For i = LBound(datas, 1) To UBound(datas, 1)
        For j = LBound(datas, 2) To UBound(datas, 2)
            If datas(i, j) Like "*" & word & "*" Then
                sheet.Cells(firstRow + i - 1, firstColumn + j - 1).Interior.ColorIndex = 3
                matchedLogs.Add datas(i, j)
            End If
        Next
    Next

    ' 結果返却
    Set SearchMatchedCell = matchedLogs

End Function

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.86%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

  • 解決済

    【VBA】任意の文字選択

    ボールドテキストいつもお世話になってます。 23歳OLです。ついに社会人2年目になりました! 本日の悩みなのですが、 ▼やりたいこと ・TODAY関数で表示した、今日の日付のと

  • 解決済

    VBA フォルダ内ループの方法

    ファルダ内ループについて教えてください。 グラフファイル@8ファイル”最大値”シートを、「計測内容」と言うファイルの”変位最大値” へ書込みをしようとしています。  そのうちの一

  • 解決済

    シートを一番右にコピー

    vbaにて開いたexcelのシートをマクロ等を実行しているexcelの一番右に常にコピーしたいのですが、どういう記述をすればよいでしょうか

  • 解決済

    既存ブックへのシートコピー

    保存対象のシートを別ブックにコピーして保存するようなマクロを組んだのですが、既存ブックが初期状態(sheet1)のみだった場合、sheet1に対してシートコピーを行い、それ以降は右

  • 解決済

    For ~ Next 繰返し処理の最後で意図しない値を得てしまいます。

    Dim p As Integer Dim yearF As Integer p = 3 Worksheets("list").Select For

  • 解決済

    シートに組み込んだマクロを指定したフォルダの中にあるエクセルファイル全てに適用したいです。

    シートに組み込んだマクロを こちらで指定したフォルダに存在するエクセルファイル全てに反映させたいと思っています。 ファイルの数が1500を超えているので一つ一つのファイルに boo

  • 解決済

    シート名のエラーを無視したい

    マクロ初心者です。 教えて下さい。 シートをコピーしようとすると「移動またはコピーしようとしている数式またはシートには、移動またはコピー先のワークシートに既にある名前’xxx’

  • 解決済

    VBA 修飾子不明、うまく実行しない

    初めまして、観覧ありがとうございます。 VBAについて、2点ほどうまくいかず、質問させていただきました。 1、sheet1で実行した際、sheet2の内容をクリアにすることがで

同じタグがついた質問を見る

  • VBA

    1551questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1328questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。