Results of 1 - 1 of about 37655 for IF (0.008 sec.)
- [[20170803094726]]
- #score: 1592
- @digest: 85db0a5feb49ea5dbcfe1f067d0fc232
- @id: 74110
- @mdate: 2017-08-28T00:20:09Z
- @size: 60636
- @type: text/plain
- #keywords: searchoption (387748), oconfsh (336112), searchfiles (252953), findstring (208674), grep (178998), outfile (144401), ignorecase (101570), startrow (41837), endrow (36572), folderpath (26869), 規表 (25729), subfolders (24825), 正規 (24149), vbexclamation (18957), ィレ (18902), トse (17377), 索対 (14989), function (13673), regexp (13042), pattern (12112), 索文 (12037), 張子 (11635), nothing (10162), トリ (10121), 小文 (9853), レク (9589), 拡張 (9524), 大文 (9499), 検索 (9469), 出力 (8731), ファ (8395), 表現 (8161)
- 『エクセルでのGrep検索』（お願いします）
VBA初心者です。 コードを書き換えて下記の機能を持つように改良したいのですが、やり方が分かりません。 下記機能を満たした書き換え後のコードと一緒にコードの解説をして下さると助かります。 -----------機能--------------------------------------------------- ・複数単語の文字列をGrep検索出来る。 →検索文字は正規表現が設定できる。 →大文字と小文字の区別が設定できる。 →検索対象はシート1枚目のセルで指定したディレクトリ。 ・検索結果を検索した文字列ごとにテキストファイルで出力。 →検索結果の出力先ディレクトリを指定できる。 →出力結果テキストファイルの名前はそれぞれシート上で記入した名前になる。 ------------------------------------------------------------------ 長くなってしましますが、元のコードです。 標準モジュール Option Explicit '----------------------------------------------------------------- ' 関 数 名:初期処理 ' 処理概要:初期設定を行う ' 引 数:なし ' 返 却 値:なし '----------------------------------------------------------------- Function init() 'カーソル変更 Application.Cursor = xlWait 'ステータスバー Application.StatusBar = "処理中......" '描画抑止 Application.ScreenUpdating = False '自動計算抑止 Application.Calculation = xlCalculationManual End Function '----------------------------------------------------------------- ' 関 数 名:終期処理 ' 処理概要:後始末を行う ' 引 数:なし ' 返 却 値:なし '-------------------------------------------------------------------------------- Function term() '自動計算抑止解除 Application.Calculation = xlCalculationAutomatic '描画抑止解除 Application.ScreenUpdating = True 'カーソル変更 Application.Cursor = xlDefault 'ステータスバー Application.StatusBar = False End Function '-------------------------------------------------------------------------------- ' 関 数 名:ハイパーリンク挿入 ' 処理概要:ハイパーリンクを設定する ' 引 数:なし ' 返 却 値:なし '-------------------------------------------------------------------------------- Public Function addHyperLink(ByRef oConfSh As Worksheet) Dim startRow As Long '検索先頭行 Dim endRow As Long '検索末尾行 Dim col As Long '検索列 Dim idx As Long startRow = oConfSh.Range(startOutAdd).Row col = oConfSh.Range(startOutAdd).Column endRow = oConfSh.Cells(Rows.Count, "G").End(xlUp).Row With oConfSh.Hyperlinks For idx = startRow To endRow .Add Anchor:=oConfSh.Cells(idx, "G"), Address:="" Next idx End With With oConfSh.Range(oConfSh.Cells(startRow, "G"), oConfSh.Cells(endRow, "G")) .Font.name = "Meiryo UI" .Font.Size = 10 End With End Function ------------------------------------------------------------------ Option Explicit '★★★★検索文字列リストの先頭アドレス Const searchListAdd As String = "B10" '★★★★対象拡張子先頭アドレス Const extentionListAdd As String = "D10" '★★★★対象ディレクトリ先頭アドレス Const dirPathAdd As String = "G10" '★★★★出力先先頭アドレス Const startOutAdd As String = "A6" '-------------------------------------------------------------------------------- ' 関 数 名:ハイパーリンク解除 ' 処理概要:ハイパーリンクを解除する ' 引 数:なし ' 返 却 値:なし '-------------------------------------------------------------------------------- Public Function releaseHyperLink(ByRef sh As Worksheet) Dim startRow As Long '検索先頭行 Dim endRow As Long '検索末尾行 Dim col As Long '検索列 startRow = oConfSh.Range(startOutAdd).Row col = oConfSh.Range(startOutAdd).Column endRow = oConfSh.Cells(Rows.Count, "G").End(xlUp).Row With sh.Range(sh.Cells(startRow, "G"), sh.Cells(endRow, "G")) .Hyperlinks.Delete .Font.name = "Meiryo UI" .Font.Size = 10 End With End Function '-------------------------------------------------------------------------------- ' 関 数 名:まとめてGrep ' 処理概要:対象ディレクトリ配下にあるファイルから、検索対象文字列リストの文字列を検索する。 ' 引 数:なし ' 返 却 値:なし '-------------------------------------------------------------------------------- Public Sub ListGrep() Dim searchOption As ClassSearchOptionInfo '検索オプション情報 Dim clsDirInfo() As ClassDirInfo '検索対象情報 Dim iDir As Long '検索ディレクトリ情報カウンタ Dim nowResRow As Long '結果出力行の先頭行 Debug.Print Timer '初期処理 Call init '画面入力値取得 Set searchOption = getSearchOption() '検索ディレクトリ情報取得 clsDirInfo = getTargetInfo(searchOption.oConfSh) For iDir = 0 To UBound(clsDirInfo) '出力シートを作成 searchOption.oTmpSh.Copy After:=ThisWorkbook.Worksheets(Worksheets.Count) Set searchOption.oOutSh = ThisWorkbook.Worksheets(Worksheets.Count) '出力シート名前変更 If clsDirInfo(iDir).outputSheetName <> "" Then searchOption.oOutSh.name = clsDirInfo(iDir).outputSheetName End If '名前の定義 If clsDirInfo(iDir).name <> "" And clsDirInfo(iDir).nameCols <> "" Then searchOption.oOutSh.Range(clsDirInfo(iDir).nameCols).name = clsDirInfo(iDir).name End If '出力位置 nowResRow = searchOption.oOutSh.Range(startOutAdd).Row 'Grep実行 Call doListGrep(clsDirInfo(iDir).topDir, searchOption, nowResRow) Next '終期処理 Call term Call searchOption.termClassSearchOptionInfo Debug.Print Timer MsgBox "(っ´ω`c)おしまい" End Sub '-------------------------------------------------------------------------------- ' 関 数 名:リストGrep処理 ' 処理概要:各ディレクトリ配下のファイルごとにGrepを行う。 ' 引 数:ByVal sTopPath As String ' ByVal searchOption As ClassSearchOptionInfo ' ByRef nowResRow As Long ' 返 却 値:なし '-------------------------------------------------------------------------------- Function doListGrep(ByVal sTopPath As String, ByVal searchOption As ClassSearchOptionInfo, ByRef nowResRow As Long) As String() 'ファイルシステムオブジェクト Dim oFSO As New FileSystemObject '先頭ディレクトリオブジェクト Dim topDir As Folder 'ディレクトリオブジェクト Dim dir As Folder 'ファイルオブジェクト Dim ofile As File '先頭ディレクトリオブジェクト取得 Set topDir = oFSO.GetFolder(sTopPath) 'ディレクトリ配下のディレクトリパス名を取得する For Each dir In topDir.SubFolders If dir.Attributes <> Alias Then Call doListGrep(dir.path, searchOption, nowResRow) End If Next 'ディレクトリ直下のファイル名を取得する For Each ofile In oFSO.GetFolder(sTopPath).Files '対象拡張子に該当するか確認する If searchOption.isTargetExtention(oFSO.GetExtensionName(ofile.name)) Then '文字列検索処理 Call searchFromFile(ofile, searchOption, nowResRow) '該当した場合は次のファイルを検査 Exit For End If Next End Function '-------------------------------------------------------------------------------- ' 関 数 名:ファイルからの指定文字列検索 ' 処理概要:ファイルを1行ずつ読み込み、リストの文字列があるか検索する ' 引 数:ByVal ofile As File ' ByVal searchOption As ClassSearchOptionInfo ' ByRef nowResRow As Long ' 返 却 値:なし '-------------------------------------------------------------------------------- Function searchFromFile(ByVal ofile As File, ByVal searchOption As ClassSearchOptionInfo, ByRef nowResRow As Long) Dim oFSO As New FileSystemObject 'ファイルシステムオブジェクト Dim oStream As TextStream 'ストリーム Dim buf, work As String '読み込み領域 Dim regEx As New regExp '正規表現オブジェクト Dim regMc As MatchCollection 'Match Collection Dim iMc As Integer 'マッチング箇所カウンタ Dim regMatch As Match '正規表現matcher Dim idx As Long '検索文字リストカウンタ Dim result(8, 0) As String 'ヒットした情報の格納領域 Dim searchList() As String '検索文字列 Dim srcSeachList() As String '検索文字列ソース '検索範囲 = 文字列全体を検索 regEx.Global = True '英大文字・小文字の区別 regEx.IgnoreCase = searchOption.isIgnoreCase searchList = searchOption.getSearchList srcSeachList = searchOption.getSrcSearchList Set oStream = oFSO.OpenTextFile(ofile.path, ForReading, False) Do While oStream.AtEndOfStream <> True '1行読み込み buf = oStream.ReadLine 'トリムして空行、コメント行（「/*」、「//」、「#」)の場合はスキップ work = Replace(buf, vbTab, "") work = Trim(work) If work = "" Or Left(work, 2) = "/*" Or Left(work, 2) = "//" _ Or Left(work, 1) = "#" Then GoTo Continue End If '検索文字リストとの比較 For idx = 0 To UBound(searchList) regEx.Pattern = searchList(idx) Set regMc = regEx.Execute(buf) 'ヒットした場合 If regMc.Count > 0 Then result(0, 0) = "=N(INDIRECT(""R[-1]C"",FALSE))+1" 'No result(1, 0) = ofile.path 'パス result(2, 0) = ofile.name 'ファイル名 result(3, 0) = oFSO.GetExtensionName(ofile.name) '拡張子 result(4, 0) = FileDateTime(ofile.path) 'タイムスタンプ result(5, 0) = FileLen(ofile.path) 'サイズ result(6, 0) = oStream.line '行 result(7, 0) = srcSeachList(idx) '検索文字 result(8, 0) = buf '検索結果 searchOption.oOutSh.Range(searchOption.oOutSh.Cells(nowResRow, 1), searchOption.oOutSh.Cells(nowResRow, 9)).Value = _ WorksheetFunction.Transpose(result) If searchOption.isHylight = xlOn Then For iMc = 0 To regMc.Count - 1 Set regMatch = regMc.item(iMc) With searchOption.oOutSh.Cells(nowResRow, "I").Characters(Start:=regMatch.FirstIndex + 1, Length:=regMatch.Length).Font '★★★★色を赤にする .Color = RGB(255, 0, 0) End With Next iMc End If nowResRow = nowResRow + 1 End If Next idx Continue: Loop oStream.Close Set oFSO = Nothing End Function '-------------------------------------------------------------------------------- ' 関 数 名:検索文字列リスト取得 ' 処理概要:検索文字列を取得する ' 引 数:なし ' 返 却 値:なし '-------------------------------------------------------------------------------- Function getSearchOption() As ClassSearchOptionInfo Dim searchOption As New ClassSearchOptionInfo 'まとめてGrepシートオブジェクト Set searchOption.oConfSh = ThisWorkbook.Worksheets("まとめてGrep") '出力シートテンプレート Set searchOption.oTmpSh = ThisWorkbook.Worksheets("まとめてGrep_tmp") '検索対象文字列 If searchOption.oConfSh.Range(searchListAdd).Value = "" Then MsgBox "検索対象文字列を入力してください。" GoTo Error End If '検索対象文字列 If searchOption.oConfSh.Range(extentionListAdd).Value = "" Then MsgBox "対象拡張子を入力してください。" GoTo Error End If '英大文字・小文字の区別をする If xlOff = searchOption.oConfSh.CheckBoxes("isIgnoreCase").Value Then searchOption.isIgnoreCase = True Else searchOption.isIgnoreCase = False End If '単語単位で検索するチェックボックス取得 searchOption.isBreak = searchOption.oConfSh.CheckBoxes("isBreak").Value '正規表現チェックボックス取得 searchOption.isRegEx = searchOption.oConfSh.CheckBoxes("isRegEx").Value '結果のハイライト searchOption.isHylight = searchOption.oConfSh.CheckBoxes("isHylight").Value Call getSearchList(searchOption) '拡張子リスト Call getExtention(searchOption) Set getSearchOption = searchOption Exit Function Error: Call term End End Function '-------------------------------------------------------------------------------- ' 関 数 名:検索対象文字列取得 ' 処理概要:検索対象文字列を配列に取得する ' 引 数:ByRef searchOption As ClassSearchOptionInfo ' 返 却 値: '-------------------------------------------------------------------------------- Function getSearchList(ByRef searchOption As ClassSearchOptionInfo) Dim startRow As Long '検索先頭行 Dim endRow As Long '検索末尾行 Dim col As Long '検索列 Dim iRow As Long '行カウンタ Dim text As String '検索文字列 Dim buf As String '検索文字列 Dim metaChar As Variant Dim searchList() As String Dim srcSearchList() As String Dim idx As Integer Dim item As Variant metaChar = Array("¥", "^", "$", "?", "*", "+", ".", "|", "{", "}", "[", "]", "(", ")") startRow = searchOption.oConfSh.Range(searchListAdd).Row col = searchOption.oConfSh.Range(searchListAdd).Column endRow = searchOption.oConfSh.Cells(Rows.Count, col).End(xlUp).Row '重複行の削除と書式再設定 Call delDupliData(searchOption.oConfSh, startRow, endRow, col) '末尾行再取得 endRow = searchOption.oConfSh.Cells(Rows.Count, col).End(xlUp).Row '-------------------------------- '検索対象文字列取得 '-------------------------------- idx = 0 For iRow = startRow To endRow text = searchOption.oConfSh.Cells(iRow, col) buf = searchOption.oConfSh.Cells(iRow, col) '正規表現OFFの場合はメタキャラクタをエスケープ If searchOption.isRegEx <> xlOn Then For Each item In metaChar buf = Replace(buf, item, "¥" & item) Next End If '単語単位で検索する場合 If searchOption.isBreak = xlOn Then buf = "¥b" & buf & "¥b" End If ReDim Preserve searchList(idx) ReDim Preserve srcSearchList(idx) searchList(idx) = buf srcSearchList(idx) = text idx = idx + 1 Next iRow Call searchOption.setSearchList(searchList) Call searchOption.setSrcSearchList(srcSearchList) End Function '-------------------------------------------------------------------------------- ' 関 数 名:検索対象ディレクトリ情報取得 ' 処理概要:検索対象ディレクトリ情報を取得する ' 引 数:ByVal oConfSh As Worksheet 設定ワークシート ' 返 却 値:ClassDirInfo '-------------------------------------------------------------------------------- Function getTargetInfo(ByVal oConfSh As Worksheet) As ClassDirInfo() Dim startRow As Long '先頭行 Dim endRow As Long '末尾行 Dim col As Long '列 Dim iRow As Long '行カウンタ Dim ext As String Dim buf As Variant '作業領域 ReDim inf(0) As New ClassDirInfo Dim idx As Long startRow = oConfSh.Range(dirPathAdd).Row col = oConfSh.Range(dirPathAdd).Column endRow = oConfSh.Cells(Rows.Count, col).End(xlUp).Row idx = 0 For iRow = startRow To endRow ReDim Preserve inf(idx) inf(idx).topDir = oConfSh.Cells(iRow, col) 'パスの存在確認 If "" = dir(inf(idx).topDir, vbDirectory) Then MsgBox iRow & " 行目の対象ディレクトリが存在しません。" GoTo Error End If '出力シート名 inf(idx).outputSheetName = oConfSh.Cells(iRow, col + 1) '名前の定義 inf(idx).name = oConfSh.Cells(iRow, col + 2) '名前を定義する列 inf(idx).nameCols = oConfSh.Cells(iRow, col + 3) idx = idx + 1 Next iRow getTargetInfo = inf Exit Function Error: Call term End End Function '-------------------------------------------------------------------------------- ' 関 数 名:重複データ削除 ' 処理概要:重複データを削除する ' 引 数:ByVal oConfSh As Worksheet シート ' ByRef startRow As Long 先頭行 ' ByRef endRow As Long 末尾行 ' ByRef col As Long 列 ' 返 却 値:String() 検索対象拡張子リスト '-------------------------------------------------------------------------------- Function delDupliData(ByVal oConfSh As Worksheet, ByRef startRow As Long, ByRef endRow As Long, ByRef col As Long) Dim rng As Range Set rng = oConfSh.Range(oConfSh.Cells(startRow, col), oConfSh.Cells(endRow, col)) With rng .RemoveDuplicates Columns:=1, Header:=xlNo .Borders.LineStyle = True .Font.name = "Meiryo UI" .Font.Size = 10 End With Set rng = Nothing End Function '-------------------------------------------------------------------------------- ' 関 数 名:検索対象拡張子取得 ' 処理概要:検索対象拡張子を配列に取得する ' 引 数:ByVal searchOption As ClassSearchOptionInfo ' 返 却 値: '-------------------------------------------------------------------------------- Function getExtention(ByVal searchOption As ClassSearchOptionInfo) Dim startRow As Long '検索先頭行 Dim endRow As Long '検索末尾行 Dim col As Long '検索列 Dim iRow As Long '行カウンタ Dim ext As String Dim buf As Variant '作業領域 ReDim extentions(0) As String Dim idx As Long startRow = searchOption.oConfSh.Range(extentionListAdd).Row col = searchOption.oConfSh.Range(extentionListAdd).Column endRow = searchOption.oConfSh.Cells(Rows.Count, col).End(xlUp).Row '重複行の削除と書式再設定 Call delDupliData(searchOption.oConfSh, startRow, endRow, col) '末尾行再取得 endRow = searchOption.oConfSh.Cells(Rows.Count, col).End(xlUp).Row idx = 0 For iRow = startRow To endRow ext = searchOption.oConfSh.Cells(iRow, col) If ext = "*" Then ext = "" Else If InStr(ext, ".") Then ext = Split(ext, ".")(1) End If End If ReDim Preserve extentions(idx) extentions(idx) = ext idx = idx + 1 Next iRow Call searchOption.setExtentionList(extentions) End Function ------------------------------------------------------------------ クラスモジュール Option Explicit '対象ディレクトリ Public topDir As String '出力シート名 Public outputSheetName As String '名前の定義 Public name As String '名前を定義する列 Public nameCols As String ------------------------------------------------------------------ Option Explicit '設定ワークシートオブジェクト Public oConfSh As Worksheet '出力シートテンプレート Public oTmpSh As Worksheet '出力シート Public oOutSh As Worksheet '検索文字列 Dim searchList() As String '検索文字列ソース Dim srcSearchList() As String '検索対象ファイル（拡張子） Dim extentionList() As String '英大文字・小文字を区別する Public isIgnoreCase As Boolean '単語単位で検索する Public isBreak As Integer '正規表現 Public isRegEx As Integer '結果のハイライト Public isHylight As Integer Public Function setExtentionList(ByRef Target() As String) extentionList = Target End Function Public Function setSearchList(ByRef Target() As String) searchList = Target End Function Public Function getSearchList() getSearchList = searchList End Function Public Function setSrcSearchList(ByRef Target() As String) srcSearchList = Target End Function Public Function getSrcSearchList() getSrcSearchList = srcSearchList End Function Public Function termClassSearchOptionInfo() Set oConfSh = Nothing Set oTmpSh = Nothing Set oOutSh = Nothing Erase searchList Erase extentionList End Function '-------------------------------------------------------------------------------- ' 関 数 名:拡張子確認 ' 処理概要:対象の拡張子であるか確認する ' 引 数:ByVal sExtention As String 拡張子 ' 返 却 値:True 該当 ' False 該当しない '-------------------------------------------------------------------------------- Public Function isTargetExtention(ByVal sExtention As String) Dim res As Variant 'ワイルドカードの場合True res = Filter(extentionList, "*", True, vbTextCompare) If sExtention <> "" And UBound(res) <> -1 Then isTargetExtention = True Exit Function End If '拡張子がマッチした場合True res = Filter(extentionList, sExtention, True, vbTextCompare) If UBound(res) <> -1 Then isTargetExtention = True Exit Function End If isTargetExtention = False End Function よろしくお願い致します。 ＜ 使用 Excel:Excel2013、使用 OS:Windows10 ＞ ---- 長すぎて、とても直したり説明したりする気にはなれないボリュームなので、ヒントだけ。 （クラスモジュールを使うコーディングは、他人に見てもらうようなレベルではないと思う…） 現状はFilter関数で判定しているかと思いますが、ちゃんとした正規表現を使いたいならば、CreateObject("VBScript.RegExp") について調べてみてください。 （???） 2017/08/03(木) 11:00 ---- ご回答、ヒントをありがとうございます。 もしよろしければ、記述した機能を実装したソースを見本として頂けないでしょうか? （お願いします） 2017/08/03(木) 11:04 ---- んー、検索すれば使用例はいくらでも出てくるように思うのですが…。 折角だから、汎用的に使えそうな例なぞ。 標準モジュールに以下を貼りつけてから、例えばA1セルにIPアドレスっぽい文字列(1.11.111.1、等)を入力。B1セル等は「=fIpCheck(A1)」としてみてください。 そして、0〜255を超える値に変えてみてください。 Function fIpCheck(cIP As String) As Boolean With CreateObject("VBScript.RegExp") .Pattern = "^(¥d|[1-9]¥d|1¥d¥d|2[0-4]¥d|25[0-5])¥.(¥d|[1-9]¥d|1¥d¥d|2[0-4]¥d|25[0-5])¥.(¥d|[1-9]¥d|1¥d¥d|2[0-4]¥d|25[0-5])¥.(¥d|[1-9]¥d|1¥d¥d|2[0-4]¥d|25[0-5])$" fIpCheck = .test(cIP) End With End Function 結果の出力云々は、まずはご自分で頑張ってみてください。 （???） 2017/08/03(木) 11:20 ---- ご回答ありがとうございます。 調べてみてもGrep検索関連は秀丸やサクラエディタになりがちで、かゆいところに手が届かない状況です。 そのためご質問させていただきました。 もう一度やれるだけやってみようかと思います （お願いします） 2017/08/03(木) 11:36 ---- ご質問の内容とは少し違いますが、GREPの部分だけ作ってみました。 一応確認はしてみましたが、どこかエラーがあるかもしれません。 検索文字列も検索するファイルも正規表現で指定します。 出力は、テキストファイルを作って、その中に [ファイル名1](該当件数) 該当文字列1 該当文字列2 : [ファイル名2](該当件数) : : という風に書き込みます。 正規表現については、RegExpで調べてみてください。 ---- '標準モジュール Option Explicit Type StringPattern '正規表現のパターン Pattern As String '大文字・小文字を区別するかどうか IgnoreCase As Boolean End Type Type FilePattern '検索するフォルダのパス(普通の文字列) FolderPath As String 'ファイル名(正規表現) FileName As String '拡張子(正規表現) Extension As String 'サブフォルダー内も検索するかどうか SubFolders As Boolean '大文字・小文字を区別するかどうか IgnoreCase As Boolean End Type 'RegExpオブジェクト Private re As Object Private ref As Object Private ree As Object 'FileSystemObjectオブジェクト Private fso As Object '結果格納用 Private buf As String 'GREP Function Grep(findString As StringPattern, searchFiles As FilePattern, outFile As String) As Boolean On Error GoTo OnError Dim ts As Object '文字列検索用RegExpオブジェクト Set re = CreateObject("VBScript.RegExp") With re .Pattern = findString.Pattern .IgnoreCase = findString.IgnoreCase .Global = True End With 'FileSystemObjectオブジェクト Set fso = CreateObject("Scripting.FileSystemObject") '検索するフォルダが存在する場合 If fso.FolderExists(searchFiles.FolderPath) Then 'ファイル名比較用RegExpオブジェクト Set ref = CreateObject("VBScript.RegExp") With ref .Pattern = searchFiles.FileName .IgnoreCase = searchFiles.IgnoreCase .Global = True End With '拡張子比較用RegExpオブジェクト Set ree = CreateObject("VBScript.RegExp") With ree .Pattern = searchFiles.Extension .IgnoreCase = searchFiles.IgnoreCase .Global = True End With 'GREP実行 If Not DoGrep(searchFiles.FolderPath, searchFiles.SubFolders) Then Grep = False Exit Function End If '変数をクリア Set ref = Nothing Set ree = Nothing '出力先フォルダが存在する場合 If fso.FolderExists(fso.GetParentFolderName(outFile)) <> "" Then 'ファイルに出力 Set ts = fso.CreateTextFile(outFile, False) ts.Write buf ts.Close Set ts = Nothing MsgBox "完了しました", vbInformation, "grep" Grep = True '出力先フォルダが存在しない場合 Else MsgBox "フォルダ '" & fso.GetParentFolderName(outFile) & "' が見つかりません", vbExclamation, "Grep" Grep = False End If '検索するフォルダが存在しない場合 Else MsgBox "フォルダ '" & searchFiles.FolderPath & "' が見つかりません", vbExclamation, "Grep" Grep = False End If '変数をクリア buf = "" Set fso = Nothing Set re = Nothing Exit Function OnError: 'エラー発生時 buf = "" Set fso = Nothing Set re = Nothing Set ref = Nothing Set ree = Nothing MsgBox Err.Description, vbCritical, "Grep" Err.Clear Grep = False End Function 'GREP実行 Private Function DoGrep(fpath As String, subfol As Boolean) As Boolean On Error GoTo OnError Dim pat As String, ext As String Dim ex As Object, m As Object Dim fc As Object, f As Object, ts As Object Dim fn As String, ft As String 'フォルダ内の全ファイル所得 Set fc = fso.GetFolder(fpath).Files For Each f In fc 'ファイル名と拡張子が条件を満たすか判定 pat = fso.GetBaseName(f.Path) ext = fso.GetExtensionName(f.Path) If ref.Test(pat) Then If ree.Test(ext) Then 'ファイルの内容を所得 fn = f.Path Set ts = f.OpenAsTextStream(1) ft = ts.ReadAll ts.Close Set ts = Nothing '検索条件に合致する文字列を格納 Set ex = re.Execute(ft) buf = buf & "[" & fn & "]" & "(" & ex.Count & "件)" & vbCrLf If ex.Count > 0 Then For Each m In ex buf = buf & m.Value & vbCrLf Next End If buf = buf & vbCrLf End If End If Next '変数をクリア Set fc = Nothing 'サブフォルダも検索する場合 If subfol Then Set fc = fso.GetFolder(fpath).SubFolders For Each f In fc 'それぞれのサブフォルダに対してGREP実行 fpath = f.Path If Not DoGrep(fpath, True) Then DoGrep = False Exit Function End If Next '変数をクリア Set fc = Nothing End If DoGrep = True Exit Function OnError: 'エラー発生時 buf = "" Set fc = Nothing Set f = Nothing Set fso = Nothing Set m = Nothing Set re = Nothing Set ref = Nothing Set ree = Nothing MsgBox Err.Description, vbCritical, "Grep" Err.Clear DoGrep = False End Function （:;:;:;:;:;） 2017/08/03(木) 21:37 ---- 回答とコードをありがとうございます。 ぜひ動作させてみて、正規表現についても頑張ってみます。 （お願いします） 2017/08/04(金) 09:16 ---- 上記のコードは自分で検索文字を受け取るセルの指定やプロシージャーを足さないと動作しませんか? （お願いします） 2017/08/04(金) 10:45 ---- 以下は、コマンドボタンのクリックで実行する例です。 セルの名前は適当に書き換えてください。 ---- 'ワークシートモジュール Private Sub CommandButon1_Click() Dim findString As StringPattern Dim searchFiles As FilePattern Dim outFile As String If Range("A1") = "" Or Range("A2") = "" Or Range("A3") = "" Or Range("A4") = "" _ Or Range("A5") = "" Or Range("A6") = "" Or Range("A7") = "" Or Range("A8") = "" Then MsgBox "入力が完了していません", vbExclamation, "Grep" Exit Sub End If With findString .Pattern = Range("A1") .IgnoreCase = Range("A2") End With With searchFiles .FolderPath = Range("A3") .FileName = Range("A4") .Extension = Range("A5") .SubFolders = Range("A6") .IgnoreCase = Range("A7") End With outFile = Range("A8") Grep findString, searchFiles, outFile End Sub （:;:;:;:;:;） 2017/08/04(金) 12:11 ---- 具体例をありがとうございます。 セルの名前を変えて実行してみたところ、On ErrorラベルのErr.Clearでプロシージャーの呼び出しが違っているか引数を誤っているかと表示されます Option Explicit Type StringPattern '正規表現のパターン Pattern As String '大文字・小文字を区別するかどうか IgnoreCase As Boolean End Type Type FilePattern '検索するフォルダのパス(普通の文字列) FolderPath As String 'ファイル名(正規表現) FileName As String '拡張子(正規表現) Extension As String 'サブフォルダー内も検索するかどうか SubFolders As Boolean '大文字・小文字を区別するかどうか IgnoreCase As Boolean End Type 'RegExpオブジェクト Private re As Object Private ref As Object Private ree As Object 'FileSystemObjectオブジェクト Private fso As Object '結果格納用 Private buf As String Private Sub CommandButon1_Click() Dim findString As StringPattern Dim searchFiles As FilePattern Dim outFile As String If Range("G12") = "" Or Range("G13") = "" Or Range("B2") = "" Or Range("G4") = "" _ Or Range("E7") = "" Or Range("G14") = "" Or Range("G13") = "" Or Range("B3") = "" Then MsgBox "入力が完了していません", vbExclamation, "Grep" Exit Sub End If With findString .Pattern = Range("G12") .IgnoreCase = Range("G13") End With With searchFiles .FolderPath = Range("B2") .FileName = Range("G4") .Extension = Range("E7") .SubFolders = Range("G14") .IgnoreCase = Range("G13") End With outFile = Range("B3") Grep findString, searchFiles, outFile End Sub 'GREP Function Grep(findString As StringPattern, searchFiles As FilePattern, outFile As String) As Boolean On Error GoTo OnError Dim ts As Object '文字列検索用RegExpオブジェクト Set re = CreateObject("VBScript.RegExp") With re .Pattern = findString.Pattern .IgnoreCase = findString.IgnoreCase .Global = True End With 'FileSystemObjectオブジェクト Set fso = CreateObject("Scripting.FileSystemObject") '検索するフォルダが存在する場合 If fso.FolderExists(searchFiles.FolderPath) Then 'ファイル名比較用RegExpオブジェクト Set ref = CreateObject("VBScript.RegExp") With ref .Pattern = searchFiles.FileName .IgnoreCase = searchFiles.IgnoreCase .Global = True End With '拡張子比較用RegExpオブジェクト Set ree = CreateObject("VBScript.RegExp") With ree .Pattern = searchFiles.Extension .IgnoreCase = searchFiles.IgnoreCase .Global = True End With 'GREP実行 If Not DoGrep(searchFiles.FolderPath, searchFiles.SubFolders) Then Grep = False Exit Function End If '変数をクリア Set ref = Nothing Set ree = Nothing '出力先フォルダが存在する場合 If fso.FolderExists(fso.GetParentFolderName(outFile)) <> "" Then 'ファイルに出力 Set ts = fso.CreateTextFile(outFile, False) ts.Write buf ts.Close Set ts = Nothing MsgBox "完了しました", vbInformation, "grep" Grep = True '出力先フォルダが存在しない場合 Else MsgBox "フォルダ '" & fso.GetParentFolderName(outFile) & "' が見つかりません", vbExclamation, "Grep" Grep = False End If '検索するフォルダが存在しない場合 Else MsgBox "フォルダ '" & searchFiles.FolderPath & "' が見つかりません", vbExclamation, "Grep" Grep = False End If '変数をクリア buf = "" Set fso = Nothing Set re = Nothing Exit Function OnError: 'エラー発生時 buf = "" Set fso = Nothing Set re = Nothing Set ref = Nothing Set ree = Nothing MsgBox Err.Description, vbCritical, "Grep" Err.Clear Grep = False End Function 'GREP実行 Private Function DoGrep(fpath As String, subfol As Boolean) As Boolean On Error GoTo OnError Dim pat As String, ext As String Dim ex As Object, m As Object Dim fc As Object, f As Object, ts As Object Dim fn As String, ft As String 'フォルダ内の全ファイル所得 Set fc = fso.GetFolder(fpath).Files For Each f In fc 'ファイル名と拡張子が条件を満たすか判定 pat = fso.GetBaseName(f.path) ext = fso.GetExtensionName(f.path) If ref.Test(pat) Then If ree.Test(ext) Then 'ファイルの内容を所得 fn = f.path Set ts = f.OpenAsTextStream(1) ft = ts.ReadAll ts.Close Set ts = Nothing '検索条件に合致する文字列を格納 Set ex = re.Execute(ft) buf = buf & "[" & fn & "]" & "(" & ex.Count & "件)" & vbCrLf If ex.Count > 0 Then For Each m In ex buf = buf & m.Value & vbCrLf Next End If buf = buf & vbCrLf End If End If Next '変数をクリア Set fc = Nothing 'サブフォルダも検索する場合 If subfol Then Set fc = fso.GetFolder(fpath).SubFolders For Each f In fc 'それぞれのサブフォルダに対してGREP実行 fpath = f.path If Not DoGrep(fpath, True) Then DoGrep = False Exit Function End If Next '変数をクリア Set fc = Nothing End If DoGrep = True Exit Function OnError: 'エラー発生時 buf = "" Set fc = Nothing Set f = Nothing Set fso = Nothing Set m = Nothing Set re = Nothing Set ref = Nothing Set ree = Nothing MsgBox Err.Description, vbCritical, "Grep" Err.Clear DoGrep = False End Function （お願いします） 2017/08/04(金) 13:52 ---- CommandButton1_Click をシートのモジュールに、その他を標準モジュールに分けてください。 シートのモジュール内ではユーザー定義型は Public では定義できません。 シートのモジュールでPrivate Type...End Type と宣言することもできますが、そのモジュール内でしか GREP が使えなくなるのであまりおすすめしません。 それでも同じエラーが出る場合は、Err.Clear を消してみてください。エラーはプロシージャが終わるとクリアされるようなので、明示的にクリアしなくてもよいものと思われます。 （:;:;:;:;:;） 2017/08/04(金) 15:40 ---- そのエラーとは関係ありませんがもう一点。 正規表現の入力が正しくない場合(例えば一文字目で前の文字を必要とする文字('*'や'+'や'?')を使った場合など)に、RegExp オブジェクトの Execute メソッドや Test メソッドが失敗してエラーが発生することがあります(試してみたところ、'アプリケーション定義またはオブジェクト定義のエラーです。'と表示されました)。 （:;:;:;:;:;） 2017/08/04(金) 15:57 ---- すみません。もう一点、説明し忘れていたところがありました。 ・IgnoreCase(大文字・小文字の区別)について findString.IgnoreCase はファイルの中身を検索するときの設定で、 searchFiles.IgnoreCase は該当するファイルを検索するときの設定です。 それぞれ独立の値を設定することができます。 ちなみに、区別する場合は False 、しない場合は True です。 （:;:;:;:;:;） 2017/08/04(金) 16:10 ---- 丁寧な説明をありがとうございます。 シートのモジュールの Grep findString, searchFiles, outFileを ↓ Call Grep(findString, searchFiles, outFile)にしたところ 先程までのエラーはなくなりました。 しかし、書き込みが出来ないとなります。 （お願いします） 2017/08/04(金) 16:39 ---- 完了のメッセージは表示されますか? （:;:;:;:;:;） 2017/08/04(金) 16:43 ---- 完了になるときはあるのですが、結果が出力されていません。 そして、出来ない時は引数は省略出来ませんとなります。 （お願いします） 2017/08/04(金) 16:45 ---- 私のPC(Windows10, Excel2013)ではうまくいくのですが...。 On Error GoTo OnError をコメントアウトしてみてください。 そうすればエラーが発生するとエラーのダイアログが出て中断されるはずなので、デバッグを選択してエラー箇所を確認してください。 （:;:;:;:;:;） 2017/08/04(金) 17:01 ---- 検索結果は出るようになったのですが、該当した文字列の数が言葉を変えても同じ結果が出力されてしまいます。 （お願いします） 2017/08/04(金) 17:49 ---- 現時点でのコードはどうなっていますか? （:;:;:;:;:;） 2017/08/04(金) 18:07 ---- 確認のため一応まとめておきます。 ・検索文字列 正規表現。大文字・小文字の区別も指定できる。 ・検索するファイル フォルダ名は普通の文字列として指定。 ファイル名は正規表現(拡張子は含めない)。 拡張子も正規表現(.は含めても含めなくてもよい)。 フォルダ名は大文字・小文字を区別せずに扱われる。 正規表現の部分は、大文字・小文字の区別も指定できる。 ・出力ファイル 普通の文字列としてフルパスで指定。 拡張子 .txt は含めても含めなくてもよい。 意図しない入力値によるエラーを防ぐため、セルの値の判定を先にするように書き加えてみました。 ---- Option Explicit Private Sub CommandButton1_Click() Dim findString As StringPattern Dim searchFiles As FilePattern Dim outFile As String If Range("G12") = "" Or Range("G13") = "" Or Range("B2") = "" Or Range("G4") = "" _ Or Range("E7") = "" Or Range("G14") = "" Or Range("G13") = "" Or Range("B3") = "" Then MsgBox "入力が完了していません", vbExclamation, "Grep" Exit Sub End If '書き加えた部分 If InStr(Range("G4"), "¥¥") > 0 Then MsgBox "ファイル名に不正な文字'¥¥'があります", vbExclamation, "Grep" Exit Sub End If Range("E7") = Replace(Range("E7"), "¥.", "") If Right(Range("B3"), 1) = "¥" Then MsgBox "出力ファイルはフルパスで指定してください", vbExclamation, "Grep" Exit Sub End If If Right(Range("B3"), 4) <> ".txt" Then Range("B3") = Range("B3") & ".txt" End If With findString .Pattern = Range("G12") .IgnoreCase = Range("G13") End With With searchFiles .FolderPath = Range("B2") .FileName = Range("G4") .Extension = Range("E7") .SubFolders = Range("G14") .IgnoreCase = Range("G13") End With outFile = Range("B3") Grep findString, searchFiles, outFile End Sub （:;:;:;:;:;） 2017/08/04(金) 18:19 ---- ・エラーの原因がわかりました。 一つ目は、ファイルが空の場合に何もないところから文字列を得ようとするようになっていたことです。これは、ファイルが空でないかの判定を先にすることで、避けられました。 二つ目は、FileSystemObject を使う時に出力できない文字があることです。テキストファイルとして読めないファイルを開いた時などにそこでエラーが発生することがあります。そこで、ADODB.Stream を使ってみたのですが、また別のエラーが発生し、最終的には Excel のファイル操作機能を使うことにしました。 ・エラー以外も改良しました。 検索に時間がかかる場合に中断できるようにするため、ループ部分に DoEvents を追加しました。 出力用のファイルとして指定されたファイルが既に存在するとき、処理前にメッセージを表示して終了するようにしました。 以下が書き直したコードです。 ---- 'シートモジュール Option Explicit Private Sub CommandButton1_Click() Dim findString As StringPattern Dim searchFiles As FilePattern Dim outFile As String If Range("G12") = "" Or Range("G13") = "" Or Range("B2") = "" Or Range("G4") = "" _ Or Range("E7") = "" Or Range("G14") = "" Or Range("G13") = "" Or Range("B3") = "" Then MsgBox "入力が完了していません", vbExclamation, "Grep" Exit Sub End If If InStr(Range("G4"), "¥¥") > 0 Then MsgBox "ファイル名に不正な文字'¥¥'があります", vbExclamation, "Grep" Exit Sub End If Range("E7") = Replace(Range("E7"), "¥.", "") If Right(Range("B3"), 1) = "¥" Then MsgBox "出力ファイルはフルパスで指定してください", vbExclamation, "Grep" Exit Sub End If If Right(Range("B3"), 4) <> ".txt" Then Range("B3") = Range("B3") & ".txt" End If With findString .Pattern = Range("G12") .IgnoreCase = Range("G13") End With With searchFiles .FolderPath = Range("B2") .FileName = Range("G4") .Extension = Range("E7") .SubFolders = Range("G14") .IgnoreCase = Range("G13") End With outFile = Range("B3") Call Grep(findString, searchFiles, outFile) End Sub ---- '標準モジュール Option Explicit Type StringPattern '正規表現のパターン Pattern As String '大文字・小文字を区別するかどうか IgnoreCase As Boolean End Type Type FilePattern '検索するフォルダのパス(普通の文字列) FolderPath As String 'ファイル名(正規表現) FileName As String '拡張子(正規表現) Extension As String 'サブフォルダー内も検索するかどうか SubFolders As Boolean '大文字・小文字を区別するかどうか IgnoreCase As Boolean End Type 'RegExpオブジェクト Private re As Object Private ref As Object Private ree As Object 'FileSystemObjectオブジェクト Private fso As Object '結果格納用 Private buf As String 'GREP Function Grep(findString As StringPattern, searchFiles As FilePattern, outFile As String) As Boolean On Error GoTo OnError Dim ff As Integer '文字列検索用RegExpオブジェクト Set re = CreateObject("VBScript.RegExp") With re .Pattern = findString.Pattern .IgnoreCase = findString.IgnoreCase .Global = True End With 'FileSystemObjectオブジェクト Set fso = CreateObject("Scripting.FileSystemObject") '検索するフォルダが存在する場合 If fso.FolderExists(searchFiles.FolderPath) Then '出力先フォルダが存在する場合 If fso.FolderExists(fso.GetParentFolderName(outFile)) Then '出力先ファイルが存在しない場合 If Not fso.FileExists(outFile) Then 'ファイル名比較用RegExpオブジェクト Set ref = CreateObject("VBScript.RegExp") With ref .Pattern = searchFiles.FileName .IgnoreCase = searchFiles.IgnoreCase .Global = True End With '拡張子比較用RegExpオブジェクト Set ree = CreateObject("VBScript.RegExp") With ree .Pattern = searchFiles.Extension .IgnoreCase = searchFiles.IgnoreCase .Global = True End With 'GREP実行 If Not DoGrep(searchFiles.FolderPath, searchFiles.SubFolders) Then Grep = False Exit Function End If '変数をクリア Set ref = Nothing Set ree = Nothing 'ファイルに出力 fso.CreateTextFile outFile, False ff = FreeFile Open outFile For Output As #ff Print #ff, buf Close ff MsgBox "完了しました", vbInformation, "Grep" Grep = True '出力先ファイルが存在する場合 Else MsgBox "ファイル '" & outFile & "' は既に存在します", vbExclamation, "Grep" Grep = False End If '出力先フォルダが存在しない場合 Else MsgBox "フォルダ '" & fso.GetParentFolderName(outFile) & "' が見つかりません", vbExclamation, "Grep" Grep = False End If '検索するフォルダが存在しない場合 Else MsgBox "フォルダ '" & searchFiles.FolderPath & "' が見つかりません", vbExclamation, "Grep" Grep = False End If '変数をクリア buf = "" Set fso = Nothing Set re = Nothing Exit Function OnError: 'エラー発生時 buf = "" Set fso = Nothing Set re = Nothing Set ref = Nothing Set ree = Nothing MsgBox Err.Description, vbCritical, "Grep" Err.Clear Grep = False End Function 'GREP実行 Private Function DoGrep(fpath As String, subfol As Boolean) As Boolean On Error GoTo OnError Dim pat As String, ext As String Dim ex As Object, m As Object Dim fc As Object, f As Object, ts As Object Dim fn As String, ft As String 'フォルダ内の全ファイル所得 Set fc = fso.GetFolder(fpath).Files For Each f In fc 'ファイル名と拡張子が条件を満たすか判定 pat = fso.GetBaseName(f.Path) ext = fso.GetExtensionName(f.Path) If ref.test(pat) Then If ree.test(ext) Then 'ファイルの内容を所得 fn = f.Path 'このブック自身を開こうとしたとき・開けないファイルがあったときは '読みとばす If fn = ThisWorkbook.Path Then ft = "" Else Set ts = f.OpenAsTextStream(1) If ts.AtEndOfStream Then ft = "" Else ft = ts.ReadAll End If ts.Close Set ts = Nothing End If '検索条件に合致する文字列を格納 Set ex = re.Execute(ft) buf = buf & "[" & fn & "]" & "(" & ex.Count & "件)" & vbCrLf If ex.Count > 0 Then For Each m In ex buf = buf & m.Value & vbCrLf Next End If buf = buf & vbCrLf End If End If DoEvents Next '変数をクリア Set fc = Nothing 'サブフォルダも検索する場合 If subfol Then Set fc = fso.GetFolder(fpath).SubFolders For Each f In fc 'それぞれのサブフォルダに対してGREP実行 fpath = f.Path If Not DoGrep(fpath, True) Then DoGrep = False Exit Function End If DoEvents Next '変数をクリア Set fc = Nothing End If DoGrep = True Exit Function OnError: 'エラー発生時 buf = "" Set fc = Nothing Set f = Nothing Set fso = Nothing Set ts = Nothing Set m = Nothing Set re = Nothing Set ref = Nothing Set ree = Nothing MsgBox Err.Description, vbCritical, "Grep" Err.Clear DoGrep = False End Function （:;:;:;:;:;） 2017/08/04(金) 23:33 ---- 返信遅れました。コードの作成をありがとうございます。 丁寧に回答をして下さって本当に助かっています。 （お願いします） 2017/08/07(月) 09:09 ---- やはり検索をしようとすると、引数を省略出来ませんと表示されてしまいます。 ステップインで進めると完了できる場合があります。 シートモジュール Private Sub CommandButton1_Click() Dim findString As StringPattern Dim searchFiles As FilePattern Dim outFile As String If Range("G12") = "" Or Range("G13") = "" Or Range("B2") = "" Or Range("B4") = "" _ Or Range("E7") = "" Or Range("G14") = "" Or Range("G15") = "" Or Range("B3") = "" Then MsgBox "入力が完了していません", vbExclamation, "Grep" Exit Sub End If If InStr(Range("B4"), "¥¥") > 0 Then MsgBox "ファイル名に不正な文字'¥¥'があります", vbExclamation, "Grep" Exit Sub End If Range("E7") = Replace(Range("E7"), "¥.", "") If Right(Range("B3"), 1) = "¥" Then MsgBox "出力ファイルはフルパスで指定してください", vbExclamation, "Grep" Exit Sub End If If Right(Range("B3"), 4) <> ".txt" Then Range("B3") = Range("B3") & ".txt" End If With findString .Pattern = Range("G12") .IgnoreCase = Range("G13") End With With searchFiles .FolderPath = Range("B2") .FileName = Range("B4") .Extension = Range("E7") .SubFolders = Range("G15") .IgnoreCase = Range("G14") End With outFile = Range("B3") Call Grep(findString, searchFiles, outFile) End Sub （お願いします） 2017/08/07(月) 09:44 ---- 今までは動作確認はDドライブでしていた(テキストファイル等はほとんどDドライブに入れているため)のですが、Cドライブ>ユーザー>ドキュメントのフォルダーで試してみたところ、「書き込みできません」というエラーが出ました。調べてみると、その原因はCドライブを操作できる権限がないことにあるようです。 お願いします さんの場合、GetFolderメソッドでフォルダーにアクセスできていないのに、.Filesとファイルを所得しようとしてエラーになっているのかもしれません(あくまで可能性の話ですが)。 可能な場合、一度他のドライブで試してみてはどうでしょうか。 （:;:;:;:;:;） 2017/08/07(月) 11:19 ---- 間違いを発見したので報告します。 DoGrep関数の If fn = ThisWorkbook.Path Then は、正しくは If fn = ThisWorkbook.Path & "¥" & ThisWorkbook.Name Then です。 （:;:;:;:;:;） 2017/08/07(月) 11:42 ---- 度々すみません。 先ほどの箇所について If fn = ThisWorkbook.Path & "¥" & ThisWorkbook.Name Or Instr(fn, "‾$") > 0 Then です。 （:;:;:;:;:;） 2017/08/07(月) 11:50 ---- 修正ありがとうございます。 出力ファイルの作成はされています。しかし検索結果が0件としか表示されません。 仮想ドライブを作成して、そこのディレクトリに対して検索を行っていますが、結果は変わらないようです。 （お願いします） 2017/08/07(月) 12:01 ---- 正規表現の文字列に間違いはありませんか? （:;:;:;:;:;） 2017/08/07(月) 12:15 ---- 正規表現を確かめましたが、問題ありませんでした。 完全一致状態での検索でも0件なので、Grepする前段階で引数を受け取り切れていないのかもしれません。 （お願いします） 2017/08/07(月) 13:09 ---- どんな種類のファイルを検索しようとしているのか教えていただけますか? （:;:;:;:;:;） 2017/08/07(月) 15:31 ---- CBLです。 テキストファイルと同じ要領で出来ると思っているのですが。 （お願いします） 2017/08/07(月) 15:38 ---- メモ帳で開いた時に、正しく文字が表示されますか? 表示されなかったら、テキストファイルのようには扱えないのでまた別の問題になるのですが...。 （:;:;:;:;:;） 2017/08/07(月) 16:02 ---- 文字の表示は正しく表示されています。 結果が出力出来ていないだけなのです。 （お願いします） 2017/08/07(月) 16:06 ---- ファイルに出力する前に buf の値を確認してみてください。 （:;:;:;:;:;） 2017/08/07(月) 16:09 ---- フォルダー名の最後に"¥"の文字がないとうまくいかないことがあると分かったので、ない場合は付け加えるようにしました。 Option Explicit Private Sub CommandButton1_Click() Dim findString As StringPattern Dim searchFiles As FilePattern Dim outFile As String If Range("G12") = "" Or Range("G13") = "" Or Range("B2") = "" Or Range("G4") = "" _ Or Range("E7") = "" Or Range("G14") = "" Or Range("G13") = "" Or Range("B3") = "" Then MsgBox "入力が完了していません", vbExclamation, "Grep" Exit Sub End If '修正した部分 If Right(Range("B2"), 1) <> "¥" Then Range("B2") = Range("B2") & "¥" End If If InStr(Range("G4"), "¥¥") > 0 Then MsgBox "ファイル名に不正な文字'¥¥'があります", vbExclamation, "Grep" Exit Sub End If Range("E7") = Replace(Range("E7"), "¥.", "") If Right(Range("B3"), 1) = "¥" Then MsgBox "出力ファイルはフルパスで指定してください", vbExclamation, "Grep" Exit Sub End If If Right(Range("B3"), 4) <> ".txt" Then Range("B3") = Range("B3") & ".txt" End If With findString .Pattern = Range("G12") .IgnoreCase = Range("G13") End With With searchFiles .FolderPath = Range("B2") .FileName = Range("G4") .Extension = Range("E7") .SubFolders = Range("G14") .IgnoreCase = Range("G13") End With outFile = Range("B3") Call GREP(findString, searchFiles, outFile) End Sub （:;:;:;:;:;） 2017/08/07(月) 16:22 ---- プリントの直前のbufはこのようになっています。 ? buf [C:¥Users¥ユーザー名¥Documents¥新しいフォルダー¥CSIDEMO.cbl](0件) [C:¥Users¥ユーザー名¥Documents¥新しいフォルダー¥LST001.CBL](0件) （お願いします） 2017/08/07(月) 16:40 ---- では、書き込みではなく、読み込みか検索が正しく行われてないということですね。 ファイルから読み込んだ文字列 ft の値を確認してみてはどうでしょうか。 （:;:;:;:;:;） 2017/08/07(月) 16:48 ---- ftの中身を見ようとしてもオブジェクトが必要ですと表示され、見れません。 ボタンクリックで検索をしようとすると「引数は省略できません」となります。 原因はそのあたりの部分っぽいです。 （お願いします） 2017/08/07(月) 17:11 ---- コードを確認していたところ、検索する文字列を格納する変数がないように思ったのですが、いかがでしょうか? （お願いします） 2017/08/07(月) 17:24 ---- 検索する文字列はftに一時的に格納して、検索を行い、結果をbufに書き加えていっています。 ftに文字列を格納するところの条件分岐はすべて Elseで当てはまらない場合の処理も書いています。 （:;:;:;:;:;） 2017/08/07(月) 17:50 ---- もしファイルがUnicodeでしたら、OpenAsTextStream(1, -1)としてください。第2引数を省略するとASCIIファイルとして開かれるようです。 （:;:;:;:;:;） 2017/08/07(月) 17:58 ---- 横入り失礼。 冒頭の長いコードは、VBA grepでヒットするサイトの ものですね。無断借用は、マナーに欠けるでしょう。 (少なくとも出典を明示すべきでしょう。) しかも丸投げ? 丸投げなら、既成のツールを使うべきでは? 秀丸なら、grep機能はじめ多機能です。 検索結果の一覧(行番号含む)から当該箇所にジャンプできます。 いわゆるタグジャンプ機能。 コード作成のツールなら、一日の長があるはずです。 なお、回答者さんの御苦労を多とする気持ちが あることも申し添えます。 （γ） 2017/08/08(火) 05:00 ---- 借用の点、思慮が足りませんでした。 VBAに関して勉強中のため、構文等をネットで調べられても自分のコードに反映させることが上手くいかず、丸投げのようになっていることも反省しております。 もちろんこの質問に対してご指摘・回答をして下さる方々に深く感謝をしております。 （お願いします） 2017/08/08(火) 09:18 ---- If ree.test(ext) の処理をするとすぐにEnd Ifに飛んでしまいます。 patとextの両方とも正しく文字列が格納しています。 （お願いします） 2017/08/08(火) 13:58 ---- End If って、どこの End If ですか? （:;:;:;:;:;） 2017/08/08(火) 14:04 ---- If ref.test(pat) Then If ree.test(ext) Then 'ファイルの内容を所得 fn = f.path 'このブック自身を開こうとしたとき・開けないファイルがあったときは '読みとばす If fn = ThisWorkbook.path & "¥" & ThisWorkbook.name Or InStr(fn, "‾$") > 0 Then ft = "" Else Set ts = f.OpenAsTextStream(1, -1) If ts.AtEndOfStream Then ft = "" Else ft = ts.ReadAll End If ts.Close Set ts = Nothing End If '検索条件に合致する文字列を格納 Set ex = re.Execute(ft) buf = buf & "[" & fn & "]" & "(" & ex.Count & "件)" & vbCrLf If ex.Count > 0 Then For Each m In ex buf = buf & m.Value & vbCrLf Next End If buf = buf & vbCrLf End If ←ここです End If （お願いします） 2017/08/08(火) 14:21 ---- buf がこのようになっているのなら、ループの中を2回通っているはずなのですが...。 ＞[C:¥Users¥ユーザー名¥Documents¥新しいフォルダー¥CSIDEMO.cbl](0件) ＞ ＞[C:¥Users¥ユーザー名¥Documents¥新しいフォルダー¥LST001.CBL](0件) ＞ （:;:;:;:;:;） 2017/08/08(火) 14:35 ---- ftに格納する文字列のセル位置を指定出来ていないのでしょうか? （お願いします） 2017/08/08(火) 16:31 ---- 念のため、入力するセルの場所です。 ・B2 検索対象ディレクトリ ・B3 出力フォルダ名までのパス ・B4 検索ファイル名 ・C7〜 検索対象文字列 ・E7〜 対象拡張子 ・G12 検索対象文字列の正規表現をするかチェックボックス ・G13 検索ファイルの正規表現設定チェックボックス ・G14 該当したファイルの大文字・小文字の区別設定チェックボックス ・G15 サブフォルダを検索するかのチェックボックス になっています。 （お願いします） 2017/08/10(木) 09:40 ---- 横から失礼。 >ftに格納する文字列のセル位置を指定出来ていないのでしょうか? TextStreamから読み出すだけなので、セル位置とかの意味が不明です。 今までの指摘の解明はどうなっていますか?しっかり確認してみては? (1) >もしファイルがUnicodeでしたら、OpenAsTextStream(1, -1)としてください これに対するご返事は? (2) If ree.test(ext) Then で直ぐに抜けていれば、buf変数への文字列セットは行われていないはずなのに、 >[C:¥Users¥ユーザー名¥Documents¥新しいフォルダー¥CSIDEMO.cbl](0件) のような表示が行われるはずがありませんとの指摘。 これについて、再確認して、事実を示してください。 (3) >念のため、入力するセルの場所です。 大事なのは、あなたがどのような値を書き入れているかです。 場所だけでは情報が不足です。 なお、当方でも正常動作することを確認しました。 （IgnoreCaseの指定が兼用されているのが気にはなりましたが。） あなたがステップ実行して想定通りに動いているかをよく確認することが最善の道です。 もしそれができないなら、回答者側で再現できるような入力を示す必要があります。 # ご自分でデバッグすらできないようなら、VBAでGrepなどといわず、 # 評価の定まって安定動作ししかもユーザーインターフェイスも工夫されている # テキストエディターのGrep機能などを使うべきです。 （γ） 2017/08/11(金) 08:54 ---- (1)について >開くファイルはshift-JIS形式です。 OpenAsTextStream(1)で正しく開けています。 (2)について >解決出来ました。 ifを想定通りに動いています。 (3)について >・B2 C:¥Users¥ユーザー名¥Documents¥新しいフォルダー ・B3 C:¥Users¥ユーザー名¥Documents¥新しいフォルダー¥tt ・B4 CSIDEMO ・C7〜 WHEN ・E7〜 cbl ・G12 チェック(TRUE) ・G13 チェック(TRUE) ・G14 チェック(TRUE) ・G15 チェック(TRUE) # のように入力しています。 # 社内用パソコンで新しくソフトを入れることが出来ない環境のため、このようにコードと格闘しつつご質# 問をさせていただいております。 # どうかこの質問にお付き合いいただけると幸いです。 （お願いします） 2017/08/21(月) 09:57 ---- # もう当方にとってはインセンティブがないのですが、放置するわけにもいきませんので。 当方では正常稼働したので、正常稼働しないという貴兄がそのことを説明して欲しいと思います。 実行に使ったソースコードはどれですか?以下の二つですか? （:;:;:;:;:;） 2017/08/04(金) 23:33 （:;:;:;:;:;） 2017/08/07(月) 16:22 入力に使用するセル位置が「2017/08/21(月) 09:57」の内容と微妙に違うようです。 また、検証結果も改めて示してください。 ブレークポイントなどを利用して途中で止めて、 ・ファイルの読み込みが適正に実行されていることをどのように確認したか。 ・正規表現による文字抽出ができていないことを、どのように確認したか を説明してください。 （γ） 2017/08/22(火) 07:02 ---- 実行してうまくいかない、だけでなく なぜ思うような結果が得られないのか、 どこが問題なのかという問題意識を持って、 デバッグをしていただきたい。 デバッグ手法はこちらを参考にしてくだし。 http://www.asahi-net.or.jp/‾ef2o-inue/vba_k/sub04_030.html http://www.asahi-net.or.jp/‾ef2o-inue/vba_k/sub04_030_02.html http://www.asahi-net.or.jp/‾ef2o-inue/vba_k/sub04_030_03.html すべてをステップ実行するわけにいかないので、 適切なところにブレークポイントを複数設けて、 その間をステップ実行するなりして、うまくいかない理由を突き詰めて下さい。 （γ） 2017/08/22(火) 07:17 ---- 時間が空いてしまいましたが、報告です。 何とか動作するようになりました。 ここまで長い時間お付き合いして、回答してくださった方々まことに感謝しております。 思うような結果がなぜ得られないのか問題意識をもって取り組むというお言葉が身に沁みました。 （お願いします） 2017/08/28(月) 09:20... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201708/20170803094726.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97038 documents and 608033 words.
訪問者：