| |
はじめまして。以下のようにファイル内の全シートを文字列検索
するものですが、schRg.Findでエラーコード1004findを設定できません。
とエラーになります。かなりおおくのシートから検索するのでオーバ
フローかと思いましたがよくわかりません。
シートが多い場合と行、列がおおい場合によくエラーが出ています。
どなたかおしえていただけないでしょうか？
Dim fn As Variant
Dim fnn As Variant
Dim schSheet As String '検索シート
Dim schColumns As String '検索列
Dim schRg As Range '検索範囲
Dim schWhat As String '検索文字
Dim fndCell As Range '検索したセル
Dim fstRow As Long '検索したセルの行
Dim fstColumn As Integer '検索したセルの列
Dim cntx As Integer
Dim aa As Integer
Dim ken As Variant
Dim fnd As Integer
Dim pp As Variant
Dim objsh As Worksheet
txt = InputBox("ファイル形式 xls")
If txt = "" Then
GoTo endr
End If
schWhat = InputBox("検索文字を入力して下さい。")
If schWhat = "" Then
GoTo endr
End If
fn = Dir("c:\m\*.xls")
Do While fn <> ""
Workbooks.Open "c:\m\" & fn
aa = Worksheets.Count
fnd = 0
cntx = 0
Set objsh = Worksheets.Add(After:=Worksheets(aa))
' シート名を設定する
objsh.Name = "dummy"
For ii = 1 To aa
Worksheets(ii).Select
'検索範囲をセット
Set schRg = Cells
Set fndCell = schRg.SpecialCells(xlLastCell)
'検索開始
Set fndCell = schRg.Find(What:=schWhat, After:=fndCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False)
'見つかった！
If Not (fndCell Is Nothing) Then
fstRow = fndCell.Row
fstColumn = fndCell.Column
Do
cntx = cntx + 1
fnd = 1
'MsgBox "ありました！ " & fndCell.Address
Sheets("dummy").Select
Sheets("dummy").Range("a" & cntx).Value = fn
pp = InStr(1, fn, ".", vbTextCompare)
ken = Left(fn, pp - 1)
Sheets("dummy").Range("b" & cntx).Value = Worksheets(ii).Name
Sheets("dummy").Range("c" & cntx).Value = fndCell.Address
Worksheets(ii).Select
Set fndCell = schRg.FindNext(After:=fndCell)
Worksheets(ii).Select
'最初に見つかったセルを再度見つけるまで続ける
Loop Until (fndCell.Row = fstRow) And (fndCell.Column = fstColumn)
End If
Next
If fnd = 1 Then
fnn = "c:\log\" & ken & "log" & ".csv"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=fnn
ActiveWorkbook.Close SaveChanges:=False
Else
ActiveWorkbook.Close SaveChanges:=False
End If
|
|
masa
- 05/5/24(火) 0:02 -
