[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『文字列 一括検索』（初めてのVBA）
たくさんのシートがある80個ぐらいのファイルから文字列を検索
しなくてはいけなくなりました
1シートづつやってますが今日中に終わりそうにないのでいい方法
がないか昨日調べたら調べるVBAがあったので使ってみたらエラー
となりました
じっくり調べたいのですが急ぎのようで
もし分かる方がいましたら教えてもらえないでしょうか
お願いします
Loop While Not c Is Nothing And c.Address <> firstAddress ↑ 実行時エラー91 オブジェクト変数またはWithブロック変数が設定されていません
Sub 文字列検索()
Dim WS As Worksheet
Dim myfolder As String
Dim Str As String
Dim a As Single
Dim sht As Worksheet
Set WS = Sheets.Add
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
myfolder = .SelectedItems(1) & "\"
End With
Str = Application.InputBox(prompt:="検索文字列:", Title:="今指定したフォルダにある全Excelファイルを検索します", Type:=2)
If Str = "False" Then Exit Sub
If Str = "" Then Exit Sub
WS.Range("A1") = "検索文字列:"
WS.Range("B1") = Str
WS.Range("A2") = "パス:"
WS.Range("B2") = myfolder
WS.Range("A3") = "ファイル名"
WS.Range("B3") = "シート名"
WS.Range("C3") = "セル"
WS.Range("D3") = "リンク"
WS.Range("E3") = "セル内の文字列"
a = 0
Application.ScreenUpdating = False
Value = Dir(myfolder)
Do Until Value = ""
If Value = "." Or Value = ".." Then
Else
If Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then
On Error Resume Next
Workbooks.Open Filename:=myfolder & Value, Password:="zzzzzzzzzzzz"
If Err.Number > 0 Then
WS.Range("A4").Offset(a, 0).Value = Value
WS.Range("B4").Offset(a, 0).Value = "Password protected"
a = a + 1
Else
On Error GoTo 0
For Each sht In ActiveWorkbook.Worksheets
'セルの文字列に完全マッチしたいならxlWholeを使う。部分マッチしたいならxlPartを使う。
' Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not c Is Nothing Then
firstAddress = c.Address
Do
WS.Range("A4").Offset(a, 0).Value = Value
WS.Range("B4").Offset(a, 0).Value = sht.Name
WS.Range("C4").Offset(a, 0).Value = c.Address
WS.Hyperlinks.Add Anchor:=WS.Range("D4").Offset(a, 0), Address:=myfolder & Value, SubAddress:= _
sht.Name & "!" & c.Address, TextToDisplay:="Link"
WS.Range("E4").Offset(a, 0).Value = c.Value
a = a + 1
Set c = sht.Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next sht
End If
Workbooks(Value).Close False
On Error GoTo 0
End If
End If
Value = Dir
Loop
Application.ScreenUpdating = True
Cells.EntireColumn.AutoFit
End Sub
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
細かいことを言わなければ、、
Sub 文字列検索()
Dim Ret, C
Dim WS As Worksheet
Dim myfolder As String
Dim Str As String
Dim a As Single
Dim sht As Worksheet
Dim firstAddress
Set WS = Sheets.Add
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
myfolder = .SelectedItems(1) & "\"
End With
Str = Application.InputBox(prompt:="検索文字列:", Title:="今指定したフォルダにある全Excelファイルを検索します", Type:=2)
If Str = "False" Then Exit Sub
If Str = "" Then Exit Sub
WS.Range("A1") = "検索文字列:"
WS.Range("B1") = Str
WS.Range("A2") = "パス:"
WS.Range("B2") = myfolder
WS.Range("A3") = "ファイル名"
WS.Range("B3") = "シート名"
WS.Range("C3") = "セル"
WS.Range("D3") = "リンク"
WS.Range("E3") = "セル内の文字列"
a = 0
Application.ScreenUpdating = False
Ret = Dir(myfolder)
Do Until Ret = ""
If Ret = "." Or Ret = ".." Then
Else
If Right(Ret, 3) = "xls" Or Right(Ret, 4) = "xlsx" Or Right(Ret, 4) = "xlsm" Then
On Error Resume Next
Workbooks.Open Filename:=myfolder & Ret, Password:="zzzzzzzzzzzz"
If Err.Number > 0 Then
WS.Range("A4").Offset(a, 0).Value = Ret
WS.Range("B4").Offset(a, 0).Value = "Password protected"
a = a + 1
On Error GoTo 0
Else
On Error GoTo 0
For Each sht In ActiveWorkbook.Worksheets
'セルの文字列に完全マッチしたいならxlWholeを使う。部分マッチしたいならxlPartを使う。
' Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
Set C = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not C Is Nothing Then
firstAddress = C.Address
Do
WS.Range("A4").Offset(a, 0).Value = Ret
WS.Range("B4").Offset(a, 0).Value = sht.Name
WS.Range("C4").Offset(a, 0).Value = C.Address
WS.Hyperlinks.Add Anchor:=WS.Range("D4").Offset(a, 0), Address:=myfolder & Ret, SubAddress:= _
sht.Name & "!" & C.Address, TextToDisplay:="Link"
WS.Range("E4").Offset(a, 0).Value = C.Value
a = a + 1
Set C = sht.Cells.FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
Next sht
End If
Workbooks(Ret).Close False
' On Error GoTo 0
End If
End If
Ret = Dir
Loop
Application.ScreenUpdating = True
Cells.EntireColumn.AutoFit
End Sub
（半平太） 2020/11/18(水) 10:46
せっかく教えて頂いたのに同じエラーとなりました
エラーの前にリンク更新or更新しないとなります
どちらを選んでもエラーとなります
LINKはあったほうが助かりますが無くても探せると思います
すいません、D列のLINKを無くすにはどうしたらいいのか
教えてもらえないでしょうか
お願いします
（初めてのVBA） 2020/11/18(水) 11:10
＞せっかく教えて頂いたのに同じエラーとなりました
同じエラーとは何のエラーですか？ これしか聞いてないですが。 ↓ ＞実行時エラー91 ＞オブジェクト変数またはWithブロック変数が設定されていません
第一、ご提示のコードそのまんまではコンパイルエラーになるハズであり、 実行後のエラーが出る以前の状態にあったと思うんですけども。
何か話がズレていると感じます。
それはともかく、リンクを無くす件に関しては、
このステートメントを消去すればいいと思います。
↓
WS.Hyperlinks.Add Anchor:=WS.Range("D4").Offset(a, 0), Address:=myfolder & Ret, SubAddress:= _
sht.Name & "!" & C.Address, TextToDisplay:="Link"
（半平太） 2020/11/18(水) 11:20
同じエラーとは
Loop While Not c Is Nothing And c.Address <> firstAddress
↑
実行時エラー91
オブジェクト変数またはWithブロック変数が設定されていません
です
VBA始めたばかりですいません
＞第一、ご提示のコードそのまんまではコンパイルエラーになるハズであり、
＞実行後のエラーが出る以前の状態にあったと思うんですけども。
あのコードではたくさんのファイル、たくさんのシートから文字列の検索は
できないということですか？
コードを実行して調べたいたくさんのファイルを入れたフォルダを選択し
検索したい文字列を入力します
そうすると
このブックには安全でない可能性のある外部ソースへのリンクが含まれて
いますと出ます
なので更新するとすると先ほどと同じエラーになります
更新しないと選択しても同じエラーとなります
このコードでは検索は難しいのでしょうか？
（初めてのVBA） 2020/11/19(木) 10:20
リンクとは、リンク数式の事だったんですね。 私はハイパーリンクの事かと思いました。
であれば、上記「ステートメントの消去」は不要なので、元に戻してください。
＞このブックには安全でない可能性のある外部ソースへのリンクが含まれて ＞いますと出ます
それは安全性の観点から、リンク数式を更新していいかどうか確認して来たものなので 「更新する」のボタンをクリックすればいいです。
＞更新する、にすると先ほどと同じエラーになります
多分、以下の処理過程で不具合が生じているんでしょうね。
＞ If Not C Is Nothing Then ＞ firstAddress = C.Address ＞ Do ＞ ’中略 ＞ Set C = sht.Cells.FindNext(C) ＞ Loop While Not C Is Nothing And C.Address <> firstAddress ＞ End If
通常、検索値が1つでもヒットすれば、以後、FindNextのループでCがNothingになることはないハズです。 何故なら、少なくとも最初ヒットしたセルに戻ってくるからです。
ところが、ヒット対象がシート上に唯一つしかなく、且つそのセルが結合セルだと、どう言う訳かCがNothingになります。 多分そんな珍しいケースがそちらの環境にあったのでしょうね。
ならば、以下に変更して、FindNextの結果もNothingかどうかチェックをしなければならない。
＞ Set C = sht.Cells.FindNext(C) ＞ Loop While Not C Is Nothing And C.Address <> firstAddress
↓へ変更
Set C = sht.Cells.FindNext(C)
If C Is Nothing Then
Exit Do
ElseIf C.Address = firstAddress Then
Exit Do
End If
Loop
（半平太） 2020/11/19(木) 16:10
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.